{-# LANGUAGE CPP           #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE Trustworthy   #-}
-- | Zipping and unzipping of functors with non-uniform shapes.
--
module Data.Zip (
    Semialign (..),
    Zip (..),
    Repeat (..),
    Unzip (..),
    unzipDefault,
    Zippy (..),
    ) where

import Control.Applicative (Applicative (..))
import Data.Monoid         (Monoid (..))
import Data.Semigroup      (Semigroup (..))
import Prelude             (Eq, Functor (..), Ord, Read, Show, ($), (.))

import Data.Semialign.Internal

#ifdef MIN_VERSION_semigroupoids
import Data.Functor.Apply (Apply (..))
#endif

-------------------------------------------------------------------------------
-- Zippy
-------------------------------------------------------------------------------

newtype Zippy f a = Zippy { Zippy f a -> f a
getZippy :: f a }
  deriving (Zippy f a -> Zippy f a -> Bool
(Zippy f a -> Zippy f a -> Bool)
-> (Zippy f a -> Zippy f a -> Bool) -> Eq (Zippy f a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (f :: * -> *) a. Eq (f a) => Zippy f a -> Zippy f a -> Bool
/= :: Zippy f a -> Zippy f a -> Bool
$c/= :: forall (f :: * -> *) a. Eq (f a) => Zippy f a -> Zippy f a -> Bool
== :: Zippy f a -> Zippy f a -> Bool
$c== :: forall (f :: * -> *) a. Eq (f a) => Zippy f a -> Zippy f a -> Bool
Eq, Eq (Zippy f a)
Eq (Zippy f a)
-> (Zippy f a -> Zippy f a -> Ordering)
-> (Zippy f a -> Zippy f a -> Bool)
-> (Zippy f a -> Zippy f a -> Bool)
-> (Zippy f a -> Zippy f a -> Bool)
-> (Zippy f a -> Zippy f a -> Bool)
-> (Zippy f a -> Zippy f a -> Zippy f a)
-> (Zippy f a -> Zippy f a -> Zippy f a)
-> Ord (Zippy f a)
Zippy f a -> Zippy f a -> Bool
Zippy f a -> Zippy f a -> Ordering
Zippy f a -> Zippy f a -> Zippy f a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (f :: * -> *) a. Ord (f a) => Eq (Zippy f a)
forall (f :: * -> *) a. Ord (f a) => Zippy f a -> Zippy f a -> Bool
forall (f :: * -> *) a.
Ord (f a) =>
Zippy f a -> Zippy f a -> Ordering
forall (f :: * -> *) a.
Ord (f a) =>
Zippy f a -> Zippy f a -> Zippy f a
min :: Zippy f a -> Zippy f a -> Zippy f a
$cmin :: forall (f :: * -> *) a.
Ord (f a) =>
Zippy f a -> Zippy f a -> Zippy f a
max :: Zippy f a -> Zippy f a -> Zippy f a
$cmax :: forall (f :: * -> *) a.
Ord (f a) =>
Zippy f a -> Zippy f a -> Zippy f a
>= :: Zippy f a -> Zippy f a -> Bool
$c>= :: forall (f :: * -> *) a. Ord (f a) => Zippy f a -> Zippy f a -> Bool
> :: Zippy f a -> Zippy f a -> Bool
$c> :: forall (f :: * -> *) a. Ord (f a) => Zippy f a -> Zippy f a -> Bool
<= :: Zippy f a -> Zippy f a -> Bool
$c<= :: forall (f :: * -> *) a. Ord (f a) => Zippy f a -> Zippy f a -> Bool
< :: Zippy f a -> Zippy f a -> Bool
$c< :: forall (f :: * -> *) a. Ord (f a) => Zippy f a -> Zippy f a -> Bool
compare :: Zippy f a -> Zippy f a -> Ordering
$ccompare :: forall (f :: * -> *) a.
Ord (f a) =>
Zippy f a -> Zippy f a -> Ordering
$cp1Ord :: forall (f :: * -> *) a. Ord (f a) => Eq (Zippy f a)
Ord, Int -> Zippy f a -> ShowS
[Zippy f a] -> ShowS
Zippy f a -> String
(Int -> Zippy f a -> ShowS)
-> (Zippy f a -> String)
-> ([Zippy f a] -> ShowS)
-> Show (Zippy f a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (f :: * -> *) a. Show (f a) => Int -> Zippy f a -> ShowS
forall (f :: * -> *) a. Show (f a) => [Zippy f a] -> ShowS
forall (f :: * -> *) a. Show (f a) => Zippy f a -> String
showList :: [Zippy f a] -> ShowS
$cshowList :: forall (f :: * -> *) a. Show (f a) => [Zippy f a] -> ShowS
show :: Zippy f a -> String
$cshow :: forall (f :: * -> *) a. Show (f a) => Zippy f a -> String
showsPrec :: Int -> Zippy f a -> ShowS
$cshowsPrec :: forall (f :: * -> *) a. Show (f a) => Int -> Zippy f a -> ShowS
Show, ReadPrec [Zippy f a]
ReadPrec (Zippy f a)
Int -> ReadS (Zippy f a)
ReadS [Zippy f a]
(Int -> ReadS (Zippy f a))
-> ReadS [Zippy f a]
-> ReadPrec (Zippy f a)
-> ReadPrec [Zippy f a]
-> Read (Zippy f a)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (f :: * -> *) a. Read (f a) => ReadPrec [Zippy f a]
forall (f :: * -> *) a. Read (f a) => ReadPrec (Zippy f a)
forall (f :: * -> *) a. Read (f a) => Int -> ReadS (Zippy f a)
forall (f :: * -> *) a. Read (f a) => ReadS [Zippy f a]
readListPrec :: ReadPrec [Zippy f a]
$creadListPrec :: forall (f :: * -> *) a. Read (f a) => ReadPrec [Zippy f a]
readPrec :: ReadPrec (Zippy f a)
$creadPrec :: forall (f :: * -> *) a. Read (f a) => ReadPrec (Zippy f a)
readList :: ReadS [Zippy f a]
$creadList :: forall (f :: * -> *) a. Read (f a) => ReadS [Zippy f a]
readsPrec :: Int -> ReadS (Zippy f a)
$creadsPrec :: forall (f :: * -> *) a. Read (f a) => Int -> ReadS (Zippy f a)
Read, a -> Zippy f b -> Zippy f a
(a -> b) -> Zippy f a -> Zippy f b
(forall a b. (a -> b) -> Zippy f a -> Zippy f b)
-> (forall a b. a -> Zippy f b -> Zippy f a) -> Functor (Zippy f)
forall a b. a -> Zippy f b -> Zippy f a
forall a b. (a -> b) -> Zippy f a -> Zippy f b
forall (f :: * -> *) a b. Functor f => a -> Zippy f b -> Zippy f a
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> Zippy f a -> Zippy f b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Zippy f b -> Zippy f a
$c<$ :: forall (f :: * -> *) a b. Functor f => a -> Zippy f b -> Zippy f a
fmap :: (a -> b) -> Zippy f a -> Zippy f b
$cfmap :: forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> Zippy f a -> Zippy f b
Functor)

instance (Zip f, Semigroup a) => Semigroup (Zippy f a) where
    Zippy f a
x <> :: Zippy f a -> Zippy f a -> Zippy f a
<> Zippy f a
y = f a -> Zippy f a
forall (f :: * -> *) a. f a -> Zippy f a
Zippy (f a -> Zippy f a) -> f a -> Zippy f a
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> f a -> f a -> f a
forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>) f a
x f a
y

instance (Repeat f, Monoid a) => Monoid (Zippy f a) where
    mempty :: Zippy f a
mempty                      = f a -> Zippy f a
forall (f :: * -> *) a. f a -> Zippy f a
Zippy (f a -> Zippy f a) -> f a -> Zippy f a
forall a b. (a -> b) -> a -> b
$ a -> f a
forall (f :: * -> *) a. Repeat f => a -> f a
repeat a
forall a. Monoid a => a
mempty
    mappend :: Zippy f a -> Zippy f a -> Zippy f a
mappend (Zippy f a
x) (Zippy f a
y) = f a -> Zippy f a
forall (f :: * -> *) a. f a -> Zippy f a
Zippy (f a -> Zippy f a) -> f a -> Zippy f a
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> f a -> f a -> f a
forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith a -> a -> a
forall a. Monoid a => a -> a -> a
mappend f a
x f a
y

#ifdef MIN_VERSION_semigroupoids
instance Zip f => Apply (Zippy f) where
    Zippy f (a -> b)
f <.> :: Zippy f (a -> b) -> Zippy f a -> Zippy f b
<.> Zippy f a
x = f b -> Zippy f b
forall (f :: * -> *) a. f a -> Zippy f a
Zippy (f b -> Zippy f b) -> f b -> Zippy f b
forall a b. (a -> b) -> a -> b
$ ((a -> b) -> a -> b) -> f (a -> b) -> f a -> f b
forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
($) f (a -> b)
f f a
x
#endif

instance Repeat f => Applicative (Zippy f) where
    pure :: a -> Zippy f a
pure  = f a -> Zippy f a
forall (f :: * -> *) a. f a -> Zippy f a
Zippy (f a -> Zippy f a) -> (a -> f a) -> a -> Zippy f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f a
forall (f :: * -> *) a. Repeat f => a -> f a
repeat
#ifdef MIN_VERSION_semigroupoids
    <*> :: Zippy f (a -> b) -> Zippy f a -> Zippy f b
(<*>) = Zippy f (a -> b) -> Zippy f a -> Zippy f b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
(<.>)
#else
    Zippy f <*> Zippy x = Zippy $ zipWith ($) f x
#endif

#if MIN_VERSION_base(4,10,0)
    liftA2 :: (a -> b -> c) -> Zippy f a -> Zippy f b -> Zippy f c
liftA2 a -> b -> c
f (Zippy f a
x) (Zippy f b
y) = f c -> Zippy f c
forall (f :: * -> *) a. f a -> Zippy f a
Zippy (f c -> Zippy f c) -> f c -> Zippy f c
forall a b. (a -> b) -> a -> b
$ (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Zip f =>
(a -> b -> c) -> f a -> f b -> f c
zipWith a -> b -> c
f f a
x f b
y
#endif