From f854bf415e01b4d0cd5638aa8b8c1b0b90cbc147 Mon Sep 17 00:00:00 2001
From: Harry Garrood <harry@garrood.me>
Date: Sun, 21 Feb 2016 18:32:38 +0000
Subject: [PATCH] Add Data.List.ZipList.transpose

Also add tests for ZipList.
---
 src/Data/List/ZipList.purs       | 23 ++++++++++++++++++++++-
 test/Test/Data/List/ZipList.purs | 32 ++++++++++++++++++++++++++++++++
 test/Test/Main.purs              |  2 ++
 3 files changed, 56 insertions(+), 1 deletion(-)
 create mode 100644 test/Test/Data/List/ZipList.purs

diff --git a/src/Data/List/ZipList.purs b/src/Data/List/ZipList.purs
index 6887e43..493aaa4 100644
--- a/src/Data/List/ZipList.purs
+++ b/src/Data/List/ZipList.purs
@@ -4,6 +4,7 @@
 module Data.List.ZipList
   ( ZipList(..)
   , runZipList
+  , transpose
   ) where
 
 import Prelude
@@ -13,9 +14,11 @@ import Control.Alternative (Alternative)
 import Control.Plus (Plus)
 
 import Data.Foldable (Foldable, foldMap, foldl, foldr)
-import Data.List.Lazy (List(), repeat, zipWith)
+import Data.List.Lazy (List(), repeat, zipWith, fromFoldable, toUnfoldable)
 import Data.Monoid (Monoid, mempty)
 import Data.Traversable (Traversable, traverse, sequence)
+import Data.Foldable (Foldable)
+import Data.Unfoldable (Unfoldable)
 
 -- | `ZipList` is a newtype around `List` which provides a zippy
 -- | `Applicative` instance.
@@ -25,6 +28,24 @@ newtype ZipList a = ZipList (List a)
 runZipList :: forall a. ZipList a -> List a
 runZipList (ZipList xs) = xs
 
+-- | Transpose any structure which is both `Foldable` and `Unfoldable`,
+-- | via `ZipList`; note that `sequence` for `ZipList` is the same as
+-- | `transpose`.
+transpose :: forall f a. (Foldable f, Unfoldable f) => f (f a) -> f (f a)
+transpose =
+  toZipList
+   >>> map toZipList
+   >>> sequence
+   >>> map fromZipList
+   >>> fromZipList
+
+  where
+  toZipList :: forall a'. f a' -> ZipList a'
+  toZipList = ZipList <<< fromFoldable
+
+  fromZipList :: forall a'. ZipList a' -> f a'
+  fromZipList = toUnfoldable <<< runZipList
+
 instance showZipList :: (Show a) => Show (ZipList a) where
   show (ZipList xs) = "(ZipList " ++ show xs ++ ")"
 
diff --git a/test/Test/Data/List/ZipList.purs b/test/Test/Data/List/ZipList.purs
new file mode 100644
index 0000000..402827d
--- /dev/null
+++ b/test/Test/Data/List/ZipList.purs
@@ -0,0 +1,32 @@
+module Test.Data.List.ZipList (testZipList) where
+
+import Prelude
+import Control.Monad.Eff (Eff())
+import Control.Monad.Eff.Console (CONSOLE(), log)
+import Data.Foldable
+import Data.Monoid.Additive
+import Data.List.Lazy as LazyList
+import Data.List.ZipList (ZipList(..), transpose)
+import Data.Maybe (Maybe(..), isNothing)
+import Data.Maybe.Unsafe (fromJust)
+import Data.Tuple (Tuple(..))
+import Data.Array as Array
+import Test.Assert (ASSERT(), assert)
+
+testZipList :: forall eff. Eff (assert :: ASSERT, console :: CONSOLE | eff) Unit
+testZipList = do
+  log "ZipList Applicative instance should be zippy"
+  testZipWith (+)   [1,2,3] [4,5,6]
+  testZipWith (*)   [1,2,3] [4,5,6]
+  testZipWith const [1,2,3] [4,5,6]
+
+  log "ZipList.transpose"
+  assert $ transpose [[1,2,3],[4,5,6],[7,8,9]] == [[1,4,7],[2,5,8],[3,6,9]]
+
+testZipWith :: forall a b c eff. (Eq c) => (a -> b -> c) -> Array a -> Array b -> Eff (assert :: ASSERT, console :: CONSOLE | eff) Unit
+testZipWith f xs ys =
+  assert $ (f <$> l xs <*> l ys) == l (Array.zipWith f xs ys)
+
+-- Shortcut for constructing a ZipList
+l :: forall a. Array a -> ZipList a
+l = ZipList <<< LazyList.fromFoldable
diff --git a/test/Test/Main.purs b/test/Test/Main.purs
index 3ce5887..30f4284 100644
--- a/test/Test/Main.purs
+++ b/test/Test/Main.purs
@@ -6,10 +6,12 @@ import Control.Monad.Eff.Console (CONSOLE())
 import Test.Assert (ASSERT())
 import Test.Data.List
 import Test.Data.List.Lazy
+import Test.Data.List.ZipList
 import Test.Data.List.Unsafe
 
 main :: forall eff. Eff (assert :: ASSERT, console :: CONSOLE | eff) Unit
 main = do
   testList
   testListLazy
+  testZipList
   testListUnsafe