base: Add missing Traversable instance for ZipList

2 files changed, 9 insertions, 3 deletions

diff --git a/libraries/base/Control/Applicative.hs b/libraries/base/Control/Applicative.hs
index 39b6466b53..a2f342f83f 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 535db00125..81e639cf37 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