[commit: ghc] master: base: Add missing Traversable instance for ZipList (a1c934c)

[git at git.haskell.org]

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

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

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

commit a1c934c1b97a09db841d20da4811e0e1310f7511
Author: Ben Gamari <ben at smart-cactus.org>
Date:   Fri Aug 7 05:50:22 2015 +0200

    base: Add missing Traversable instance for ZipList


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

a1c934c1b97a09db841d20da4811e0e1310f7511
 libraries/base/Control/Applicative.hs | 5 +++--
 libraries/base/Data/Traversable.hs    | 7 ++++++-
 2 files changed, 9 insertions(+), 3 deletions(-)

diff --git a/libraries/base/Control/Applicative.hs b/libraries/base/Control/Applicative.hs
index 39b6466..a2f342f 100644
--- a/libraries/base/Control/Applicative.hs
+++ b/libraries/base/Control/Applicative.hs
@@ -122,8 +122,9 @@ 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, Foldable
-                           , Generic, Generic1)
+                  deriving ( Show, Eq, Ord, Read, Functor
+                           , Foldable, Generic, Generic1)
+-- See Data.Traversable for Traversabel instance due to import loops
 
 instance Applicative ZipList where
     pure x = ZipList (repeat x)
diff --git a/libraries/base/Data/Traversable.hs b/libraries/base/Data/Traversable.hs
index 535db00..81e639c 100644
--- a/libraries/base/Data/Traversable.hs
+++ b/libraries/base/Data/Traversable.hs
@@ -46,7 +46,9 @@ module Data.Traversable (
     foldMapDefault,
     ) where
 
-import Control.Applicative ( Const(..) )
+-- It is convenient to use 'Const' here but this means we must
+-- define a few instances here which really belong in Control.Applicative
+import Control.Applicative ( Const(..), ZipList(..) )
 import Data.Either ( Either(..) )
 import Data.Foldable ( Foldable )
 import Data.Functor
@@ -217,6 +219,9 @@ instance Traversable First where
 instance Traversable Last where
     traverse f (Last x) = Last <$> traverse f x
 
+instance Traversable ZipList where
+    traverse f (ZipList x) = ZipList <$> traverse f x
+
 -- general functions
 
 -- | 'for' is 'traverse' with its arguments flipped. For a version