-- | Various zipping and unzipping functions for chunked data structures.
module Data.ChunkedZip where

import Prelude hiding (zipWith, zipWith3)
import Control.Arrow ((&&&), (***))
import qualified Data.List as List
import qualified Data.List.NonEmpty as NonEmpty
import Data.List.NonEmpty (NonEmpty)
import qualified Data.Vector as Vector
-- import qualified Data.Vector.Unboxed as UVector
import qualified Data.Sequence as Seq
import Control.Monad.Trans.Identity
import Control.Monad.Trans.Reader
import qualified Data.IntMap as IntMap
import Data.Tree
import Data.Functor.Compose
import Data.Foldable (toList)

class Functor f => Zip f where
    zipWith :: (a -> b -> c) -> f a -> f b -> f c

    zip :: f a -> f b -> f (a, b)
    zip = forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith (,)

    zap :: f (a -> b) -> f a -> f b
    zap = forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith forall a. a -> a
id

    unzip :: f (a, b) -> (f a, f b)
    unzip = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd

instance Zip [] where
    zip :: forall a b. [a] -> [b] -> [(a, b)]
zip = forall a b. [a] -> [b] -> [(a, b)]
List.zip
    zipWith :: forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
List.zipWith
    unzip :: forall a b. [(a, b)] -> ([a], [b])
unzip = forall a b. [(a, b)] -> ([a], [b])
List.unzip
instance Zip NonEmpty where
    zipWith :: forall a b c.
(a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
zipWith = forall a b c.
(a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
NonEmpty.zipWith
    zip :: forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
zip = forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
NonEmpty.zip
    unzip :: forall a b. NonEmpty (a, b) -> (NonEmpty a, NonEmpty b)
unzip = forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
NonEmpty.unzip
instance Zip Seq.Seq where
    zip :: forall a b. Seq a -> Seq b -> Seq (a, b)
zip = forall a b. Seq a -> Seq b -> Seq (a, b)
Seq.zip
    zipWith :: forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
zipWith = forall a b c. (a -> b -> c) -> Seq a -> Seq b -> Seq c
Seq.zipWith
    unzip :: forall a b. Seq (a, b) -> (Seq a, Seq b)
unzip = (forall a. [a] -> Seq a
Seq.fromList forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall a. [a] -> Seq a
Seq.fromList) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [(a, b)] -> ([a], [b])
List.unzip forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
instance Zip Tree where
    zipWith :: forall a b c. (a -> b -> c) -> Tree a -> Tree b -> Tree c
zipWith a -> b -> c
f (Node a
a [Tree a]
as) (Node b
b [Tree b]
bs) = forall a. a -> [Tree a] -> Tree a
Node (a -> b -> c
f a
a b
b) (forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith (forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith a -> b -> c
f) [Tree a]
as [Tree b]
bs)
instance Zip Vector.Vector where
    zip :: forall a b. Vector a -> Vector b -> Vector (a, b)
zip = forall a b. Vector a -> Vector b -> Vector (a, b)
Vector.zip
    unzip :: forall a b. Vector (a, b) -> (Vector a, Vector b)
unzip = forall a b. Vector (a, b) -> (Vector a, Vector b)
Vector.unzip
    zipWith :: forall a b c. (a -> b -> c) -> Vector a -> Vector b -> Vector c
zipWith = forall a b c. (a -> b -> c) -> Vector a -> Vector b -> Vector c
Vector.zipWith
  {-
instance Zip UVector where
    zip = UVector.zip
    unzip = UVector.unzip
    zipWith = UVector.zipWith
    -}

instance Zip m => Zip (IdentityT m) where
    zipWith :: forall a b c.
(a -> b -> c) -> IdentityT m a -> IdentityT m b -> IdentityT m c
zipWith a -> b -> c
f (IdentityT m a
m) (IdentityT m b
n) = forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT (forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith a -> b -> c
f m a
m m b
n)
instance Zip ((->)a) where
    zipWith :: forall a b c. (a -> b -> c) -> (a -> a) -> (a -> b) -> a -> c
zipWith a -> b -> c
f a -> a
g a -> b
h a
a = a -> b -> c
f (a -> a
g a
a) (a -> b
h a
a)
instance Zip m => Zip (ReaderT e m) where
    zipWith :: forall a b c.
(a -> b -> c) -> ReaderT e m a -> ReaderT e m b -> ReaderT e m c
zipWith a -> b -> c
f (ReaderT e -> m a
m) (ReaderT e -> m b
n) = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \e
a ->
      forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith a -> b -> c
f (e -> m a
m e
a) (e -> m b
n e
a)
instance Zip IntMap.IntMap where
    zipWith :: forall a b c. (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
zipWith = forall a b c. (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
IntMap.intersectionWith
instance (Zip f, Zip g) => Zip (Compose f g) where
    zipWith :: forall a b c.
(a -> b -> c) -> Compose f g a -> Compose f g b -> Compose f g c
zipWith a -> b -> c
f (Compose f (g a)
a) (Compose f (g b)
b) = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith (forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith a -> b -> c
f) f (g a)
a f (g b)
b

class Functor f => Zip3 f where
    zipWith3 :: (a -> b -> c -> d) -> f a -> f b -> f c -> f d

    zip3 :: f a -> f b -> f c -> f (a, b, c)
    zip3 = forall (f :: * -> *) a b c d.
Zip3 f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
zipWith3 (\a
x b
y c
z -> (a
x,b
y,c
z))

    zap3 :: f (a -> b -> c) -> f a -> f b -> f c
    zap3 = forall (f :: * -> *) a b c d.
Zip3 f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
zipWith3 forall a. a -> a
id

    unzip3 :: f (a, b, c) -> (f a, f b, f c)
    -- unzip3 = fmap (\(x,_,_)->x) &&& fmap (\(_,x,_)->x) &&& fmap (\(_,_,x)->x)

instance Zip3 [] where
    zip3 :: forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 = forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
List.zip3
    unzip3 :: forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 = forall a b c. [(a, b, c)] -> ([a], [b], [c])
List.unzip3
    zipWith3 :: forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 = forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
List.zipWith3
instance Zip3 Vector.Vector where
    zip3 :: forall a b c. Vector a -> Vector b -> Vector c -> Vector (a, b, c)
zip3 = forall a b c. Vector a -> Vector b -> Vector c -> Vector (a, b, c)
Vector.zip3
    unzip3 :: forall a b c. Vector (a, b, c) -> (Vector a, Vector b, Vector c)
unzip3 = forall a b c. Vector (a, b, c) -> (Vector a, Vector b, Vector c)
Vector.unzip3
    zipWith3 :: forall a b c d.
(a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d
zipWith3 = forall a b c d.
(a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d
Vector.zipWith3
instance Zip3 Seq.Seq where
    zip3 :: forall a b c. Seq a -> Seq b -> Seq c -> Seq (a, b, c)
zip3 = forall a b c. Seq a -> Seq b -> Seq c -> Seq (a, b, c)
Seq.zip3
    unzip3 :: forall a b c. Seq (a, b, c) -> (Seq a, Seq b, Seq c)
unzip3 = (\([a]
a, [b]
b, [c]
c) -> (forall a. [a] -> Seq a
Seq.fromList [a]
a, forall a. [a] -> Seq a
Seq.fromList [b]
b, forall a. [a] -> Seq a
Seq.fromList [c]
c)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. [(a, b, c)] -> ([a], [b], [c])
List.unzip3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
    zipWith3 :: forall a b c d.
(a -> b -> c -> d) -> Seq a -> Seq b -> Seq c -> Seq d
zipWith3 = forall a b c d.
(a -> b -> c -> d) -> Seq a -> Seq b -> Seq c -> Seq d
Seq.zipWith3

class Functor f => Zip4 f where
    zipWith4 :: (a -> b -> c -> d -> e) -> f a -> f b -> f c -> f d -> f e

    zip4 :: f a -> f b -> f c -> f d ->  f (a, b, c, d)
    zip4 = forall (f :: * -> *) a b c d e.
Zip4 f =>
(a -> b -> c -> d -> e) -> f a -> f b -> f c -> f d -> f e
zipWith4 (\a
w b
x c
y d
z -> (a
w, b
x,c
y,d
z))

    zap4 :: f (a -> b -> c -> d) -> f a -> f b -> f c -> f d
    zap4 = forall (f :: * -> *) a b c d e.
Zip4 f =>
(a -> b -> c -> d -> e) -> f a -> f b -> f c -> f d -> f e
zipWith4 forall a. a -> a
id

    unzip4 :: f (a, b, c, d) -> (f a, f b, f c, f d)

instance Zip4 [] where
    zip4 :: forall a b c d. [a] -> [b] -> [c] -> [d] -> [(a, b, c, d)]
zip4 = forall a b c d. [a] -> [b] -> [c] -> [d] -> [(a, b, c, d)]
List.zip4
    unzip4 :: forall a b c d. [(a, b, c, d)] -> ([a], [b], [c], [d])
unzip4 = forall a b c d. [(a, b, c, d)] -> ([a], [b], [c], [d])
List.unzip4
    zipWith4 :: forall a b c d e.
(a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e]
zipWith4 = forall a b c d e.
(a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e]
List.zipWith4
instance Zip4 Vector.Vector where
    zip4 :: forall a b c d.
Vector a -> Vector b -> Vector c -> Vector d -> Vector (a, b, c, d)
zip4 = forall a b c d.
Vector a -> Vector b -> Vector c -> Vector d -> Vector (a, b, c, d)
Vector.zip4
    unzip4 :: forall a b c d.
Vector (a, b, c, d) -> (Vector a, Vector b, Vector c, Vector d)
unzip4 = forall a b c d.
Vector (a, b, c, d) -> (Vector a, Vector b, Vector c, Vector d)
Vector.unzip4
    zipWith4 :: forall a b c d e.
(a -> b -> c -> d -> e)
-> Vector a -> Vector b -> Vector c -> Vector d -> Vector e
zipWith4 = forall a b c d e.
(a -> b -> c -> d -> e)
-> Vector a -> Vector b -> Vector c -> Vector d -> Vector e
Vector.zipWith4
instance Zip4 Seq.Seq where
    zip4 :: forall a b c d.
Seq a -> Seq b -> Seq c -> Seq d -> Seq (a, b, c, d)
zip4 = forall a b c d.
Seq a -> Seq b -> Seq c -> Seq d -> Seq (a, b, c, d)
Seq.zip4
    unzip4 :: forall a b c d. Seq (a, b, c, d) -> (Seq a, Seq b, Seq c, Seq d)
unzip4 = (\([a]
a, [b]
b, [c]
c, [d]
d) -> (forall a. [a] -> Seq a
Seq.fromList [a]
a, forall a. [a] -> Seq a
Seq.fromList [b]
b, forall a. [a] -> Seq a
Seq.fromList [c]
c, forall a. [a] -> Seq a
Seq.fromList [d]
d)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c d. [(a, b, c, d)] -> ([a], [b], [c], [d])
List.unzip4 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
    zipWith4 :: forall a b c d e.
(a -> b -> c -> d -> e)
-> Seq a -> Seq b -> Seq c -> Seq d -> Seq e
zipWith4 = forall a b c d e.
(a -> b -> c -> d -> e)
-> Seq a -> Seq b -> Seq c -> Seq d -> Seq e
Seq.zipWith4

class Functor f => Zip5 f where
    zipWith5 :: (a -> b -> c -> d -> e -> g) -> f a -> f b -> f c -> f d -> f e -> f g

    zip5 :: f a -> f b -> f c -> f d -> f e -> f (a, b, c, d, e)
    zip5 = forall (f :: * -> *) a b c d e g.
Zip5 f =>
(a -> b -> c -> d -> e -> g)
-> f a -> f b -> f c -> f d -> f e -> f g
zipWith5 (\a
v b
w c
x d
y e
z -> (a
v,b
w,c
x,d
y,e
z))

    zap5 :: f (a -> b -> c -> d -> e) -> f a -> f b -> f c -> f d -> f e
    zap5 = forall (f :: * -> *) a b c d e g.
Zip5 f =>
(a -> b -> c -> d -> e -> g)
-> f a -> f b -> f c -> f d -> f e -> f g
zipWith5 forall a. a -> a
id

    unzip5 :: f (a, b, c, d, e) -> (f a, f b, f c, f d, f e)

instance Zip5 [] where
    zip5 :: forall a b c d e.
[a] -> [b] -> [c] -> [d] -> [e] -> [(a, b, c, d, e)]
zip5 = forall a b c d e.
[a] -> [b] -> [c] -> [d] -> [e] -> [(a, b, c, d, e)]
List.zip5
    unzip5 :: forall a b c d e. [(a, b, c, d, e)] -> ([a], [b], [c], [d], [e])
unzip5 = forall a b c d e. [(a, b, c, d, e)] -> ([a], [b], [c], [d], [e])
List.unzip5
    zipWith5 :: forall a b c d e g.
(a -> b -> c -> d -> e -> g)
-> [a] -> [b] -> [c] -> [d] -> [e] -> [g]
zipWith5 = forall a b c d e g.
(a -> b -> c -> d -> e -> g)
-> [a] -> [b] -> [c] -> [d] -> [e] -> [g]
List.zipWith5
instance Zip5 Vector.Vector where
    zip5 :: forall a b c d e.
Vector a
-> Vector b
-> Vector c
-> Vector d
-> Vector e
-> Vector (a, b, c, d, e)
zip5 = forall a b c d e.
Vector a
-> Vector b
-> Vector c
-> Vector d
-> Vector e
-> Vector (a, b, c, d, e)
Vector.zip5
    unzip5 :: forall a b c d e.
Vector (a, b, c, d, e)
-> (Vector a, Vector b, Vector c, Vector d, Vector e)
unzip5 = forall a b c d e.
Vector (a, b, c, d, e)
-> (Vector a, Vector b, Vector c, Vector d, Vector e)
Vector.unzip5
    zipWith5 :: forall a b c d e g.
(a -> b -> c -> d -> e -> g)
-> Vector a
-> Vector b
-> Vector c
-> Vector d
-> Vector e
-> Vector g
zipWith5 = forall a b c d e g.
(a -> b -> c -> d -> e -> g)
-> Vector a
-> Vector b
-> Vector c
-> Vector d
-> Vector e
-> Vector g
Vector.zipWith5

class Functor f => Zip6 f where
    zipWith6 :: (a -> b -> c -> d -> e -> g -> h) -> f a -> f b -> f c -> f d -> f e -> f g -> f h

    zip6 :: f a -> f b -> f c -> f d -> f e -> f g -> f (a, b, c, d, e, g)
    zip6 = forall (f :: * -> *) a b c d e g h.
Zip6 f =>
(a -> b -> c -> d -> e -> g -> h)
-> f a -> f b -> f c -> f d -> f e -> f g -> f h
zipWith6 (\a
u b
v c
w d
x e
y g
z -> (a
u, b
v,c
w,d
x,e
y,g
z))

    zap6 :: f (a -> b -> c -> d -> e -> g) -> f a -> f b -> f c -> f d -> f e -> f g
    zap6 = forall (f :: * -> *) a b c d e g h.
Zip6 f =>
(a -> b -> c -> d -> e -> g -> h)
-> f a -> f b -> f c -> f d -> f e -> f g -> f h
zipWith6 forall a. a -> a
id

    unzip6 :: f (a, b, c, d, e, g) -> (f a, f b, f c, f d, f e, f g)

instance Zip6 [] where
    zip6 :: forall a b c d e g.
[a] -> [b] -> [c] -> [d] -> [e] -> [g] -> [(a, b, c, d, e, g)]
zip6 = forall a b c d e g.
[a] -> [b] -> [c] -> [d] -> [e] -> [g] -> [(a, b, c, d, e, g)]
List.zip6
    unzip6 :: forall a b c d e g.
[(a, b, c, d, e, g)] -> ([a], [b], [c], [d], [e], [g])
unzip6 = forall a b c d e g.
[(a, b, c, d, e, g)] -> ([a], [b], [c], [d], [e], [g])
List.unzip6
    zipWith6 :: forall a b c d e g h.
(a -> b -> c -> d -> e -> g -> h)
-> [a] -> [b] -> [c] -> [d] -> [e] -> [g] -> [h]
zipWith6 = forall a b c d e g h.
(a -> b -> c -> d -> e -> g -> h)
-> [a] -> [b] -> [c] -> [d] -> [e] -> [g] -> [h]
List.zipWith6
instance Zip6 Vector.Vector where
    zip6 :: forall a b c d e g.
Vector a
-> Vector b
-> Vector c
-> Vector d
-> Vector e
-> Vector g
-> Vector (a, b, c, d, e, g)
zip6 = forall a b c d e g.
Vector a
-> Vector b
-> Vector c
-> Vector d
-> Vector e
-> Vector g
-> Vector (a, b, c, d, e, g)
Vector.zip6
    unzip6 :: forall a b c d e g.
Vector (a, b, c, d, e, g)
-> (Vector a, Vector b, Vector c, Vector d, Vector e, Vector g)
unzip6 = forall a b c d e g.
Vector (a, b, c, d, e, g)
-> (Vector a, Vector b, Vector c, Vector d, Vector e, Vector g)
Vector.unzip6
    zipWith6 :: forall a b c d e g h.
(a -> b -> c -> d -> e -> g -> h)
-> Vector a
-> Vector b
-> Vector c
-> Vector d
-> Vector e
-> Vector g
-> Vector h
zipWith6 = forall a b c d e g h.
(a -> b -> c -> d -> e -> g -> h)
-> Vector a
-> Vector b
-> Vector c
-> Vector d
-> Vector e
-> Vector g
-> Vector h
Vector.zipWith6

class Functor f => Zip7 f where
    zipWith7 :: (a -> b -> c -> d -> e -> g -> h -> i) -> f a -> f b -> f c -> f d -> f e -> f g -> f h -> f i

    zip7 :: f a -> f b -> f c -> f d -> f e -> f g -> f h -> f (a, b, c, d, e, g, h)
    zip7 = forall (f :: * -> *) a b c d e g h i.
Zip7 f =>
(a -> b -> c -> d -> e -> g -> h -> i)
-> f a -> f b -> f c -> f d -> f e -> f g -> f h -> f i
zipWith7 (\a
t b
u c
v d
w e
x g
y h
z -> (a
t,b
u,c
v,d
w,e
x,g
y,h
z))

    zap7 :: f (a -> b -> c -> d -> e -> g -> h) -> f a -> f b -> f c -> f d -> f e -> f g -> f h
    zap7 = forall (f :: * -> *) a b c d e g h i.
Zip7 f =>
(a -> b -> c -> d -> e -> g -> h -> i)
-> f a -> f b -> f c -> f d -> f e -> f g -> f h -> f i
zipWith7 forall a. a -> a
id

    unzip7 :: f (a, b, c, d, e, g, h) -> (f a, f b, f c, f d, f e, f g, f h)
    -- unzip3 = fmap (\(x,_,_)->x) &&& fmap (\(_,x,_)->x) &&& fmap (\(_,_,x)->x)

instance Zip7 [] where
    zip7 :: forall a b c d e g h.
[a]
-> [b]
-> [c]
-> [d]
-> [e]
-> [g]
-> [h]
-> [(a, b, c, d, e, g, h)]
zip7 = forall a b c d e g h.
[a]
-> [b]
-> [c]
-> [d]
-> [e]
-> [g]
-> [h]
-> [(a, b, c, d, e, g, h)]
List.zip7
    unzip7 :: forall a b c d e g h.
[(a, b, c, d, e, g, h)] -> ([a], [b], [c], [d], [e], [g], [h])
unzip7 = forall a b c d e g h.
[(a, b, c, d, e, g, h)] -> ([a], [b], [c], [d], [e], [g], [h])
List.unzip7
    zipWith7 :: forall a b c d e g h i.
(a -> b -> c -> d -> e -> g -> h -> i)
-> [a] -> [b] -> [c] -> [d] -> [e] -> [g] -> [h] -> [i]
zipWith7 = forall a b c d e g h i.
(a -> b -> c -> d -> e -> g -> h -> i)
-> [a] -> [b] -> [c] -> [d] -> [e] -> [g] -> [h] -> [i]
List.zipWith7