[commit: ghc] master: base: Add instances (97843d0)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/97843d0b10cac3912a85329ebcb8ed1a68f71b34/ghc

>---------------------------------------------------------------

commit 97843d0b10cac3912a85329ebcb8ed1a68f71b34
Author: fumieval <fumiexcel at gmail.com>
Date:   Thu Aug 6 17:28:04 2015 +0200

    base: Add instances
    
    This patch adds following instances:
    
    * Foldable ZipList
    * Traversable ZipList
    * Functor Complex
    * Applicative Complex
    * Monad Complex
    * Foldable Complex
    * Traversable Complex
    * Generic1 Complex
    * Monoid a => Monoid (Identity a)
    * Storable ()
    
    Reviewers: ekmett, fumieval, hvr, austin
    
    Subscribers: thomie, #core_libraries_committee
    
    Projects: #core_libraries_committee
    
    Differential Revision: https://phabricator.haskell.org/D1049
    
    GHC Trac Issues: #10609


>---------------------------------------------------------------

97843d0b10cac3912a85329ebcb8ed1a68f71b34
 libraries/base/Control/Applicative.hs   |  3 ++-
 libraries/base/Data/Complex.hs          | 16 ++++++++++++++--
 libraries/base/Data/Functor/Identity.hs |  3 ++-
 libraries/base/Foreign/Storable.hs      |  6 ++++++
 libraries/base/changelog.md             |  9 ++++++++-
 5 files changed, 32 insertions(+), 5 deletions(-)

diff --git a/libraries/base/Control/Applicative.hs b/libraries/base/Control/Applicative.hs
index 521ea9f..39b6466 100644
--- a/libraries/base/Control/Applicative.hs
+++ b/libraries/base/Control/Applicative.hs
@@ -122,7 +122,8 @@ instance (ArrowZero a, ArrowPlus a) => Alternative (WrappedArrow a b) where
 -- @f '<$>' 'ZipList' xs1 '<*>' ... '<*>' 'ZipList' xsn = 'ZipList' (zipWithn f xs1 ... xsn)@
 --
 newtype ZipList a = ZipList { getZipList :: [a] }
-                  deriving (Show, Eq, Ord, Read, Functor, Generic, Generic1)
+                  deriving ( Show, Eq, Ord, Read, Functor, Foldable
+                           , Generic, Generic1)
 
 instance Applicative ZipList where
     pure x = ZipList (repeat x)
diff --git a/libraries/base/Data/Complex.hs b/libraries/base/Data/Complex.hs
index c6420cd..09314f1 100644
--- a/libraries/base/Data/Complex.hs
+++ b/libraries/base/Data/Complex.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE Trustworthy #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveTraversable #-}
 
 -----------------------------------------------------------------------------
 -- |
@@ -35,7 +36,7 @@ module Data.Complex
 
         )  where
 
-import GHC.Generics (Generic)
+import GHC.Generics (Generic, Generic1)
 import Data.Data (Data)
 import Foreign (Storable, castPtr, peek, poke, pokeElemOff, peekElemOff, sizeOf,
                 alignment)
@@ -50,10 +51,13 @@ infix  6  :+
 -- For a complex number @z@, @'abs' z@ is a number with the magnitude of @z@,
 -- but oriented in the positive real direction, whereas @'signum' z@
 -- has the phase of @z@, but unit magnitude.
+--
+-- The 'Foldable' and 'Traversable' instances traverse the real part first.
 data Complex a
   = !a :+ !a    -- ^ forms a complex number from its real and imaginary
                 -- rectangular components.
-        deriving (Eq, Show, Read, Data, Generic)
+        deriving (Eq, Show, Read, Data, Generic, Generic1
+                , Functor, Foldable, Traversable)
 
 -- -----------------------------------------------------------------------------
 -- Functions over Complex
@@ -203,3 +207,11 @@ instance Storable a => Storable (Complex a) where
                         q <-return $  (castPtr p)
                         poke q r
                         pokeElemOff q 1 i
+
+instance Applicative Complex where
+  pure a = a :+ a
+  f :+ g <*> a :+ b = f a :+ g b
+
+instance Monad Complex where
+  return a = a :+ a
+  a :+ b >>= f = realPart (f a) :+ imagPart (f b)
diff --git a/libraries/base/Data/Functor/Identity.hs b/libraries/base/Data/Functor/Identity.hs
index 59ecc7f..9f7ae24 100644
--- a/libraries/base/Data/Functor/Identity.hs
+++ b/libraries/base/Data/Functor/Identity.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE Trustworthy #-}
 
 -----------------------------------------------------------------------------
@@ -44,7 +45,7 @@ import GHC.Generics (Generic, Generic1)
 --
 -- @since 4.8.0.0
 newtype Identity a = Identity { runIdentity :: a }
-    deriving (Eq, Ord, Data, Traversable, Generic, Generic1)
+    deriving (Eq, Ord, Data, Monoid, Traversable, Generic, Generic1)
 
 -- | This instance would be equivalent to the derived instances of the
 -- 'Identity' newtype if the 'runIdentity' field were removed
diff --git a/libraries/base/Foreign/Storable.hs b/libraries/base/Foreign/Storable.hs
index 52f3eda..5b657a1 100644
--- a/libraries/base/Foreign/Storable.hs
+++ b/libraries/base/Foreign/Storable.hs
@@ -145,6 +145,12 @@ class Storable a where
    peek ptr = peekElemOff ptr 0
    poke ptr = pokeElemOff ptr 0
 
+instance Storable () where
+  sizeOf _ = 0
+  alignment _ = 1
+  peek _ = return ()
+  poke _ _ = return ()
+
 -- System-dependent, but rather obvious instances
 
 instance Storable Bool where
diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md
index bad0e8a..2306d36 100644
--- a/libraries/base/changelog.md
+++ b/libraries/base/changelog.md
@@ -19,6 +19,12 @@
 
   * `(,) a` now has a `Monad` instance
 
+  * `ZipList` now has `Foldable` and `Traversable` instances
+
+  * `Identity` now has a `Monoid` instance
+
+  * `()` now has a `Storable` instance
+
   * Redundant typeclass constraints have been removed:
      - `Data.Ratio.{denominator,numerator}` have no `Integral` constraint anymore
      - **TODO**
@@ -29,7 +35,8 @@
 
   * New `GHC.Stack.CallStack` data type
 
-  * `Complex` now has a `Generic` instance
+  * `Complex` now has `Generic`, `Generic1`, `Functor`, `Foldable`, `Traversable`,
+    `Applicative`, and `Monad` instances
 
   * `System.Exit.ExitCode` now has a `Generic` instance