{-# LANGUAGE Safe #-}
{-# LANGUAGE TypeOperators #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Monad.Zip
-- Copyright   :  (c) Nils Schweinsberg 2011,
--                (c) George Giorgidze 2011
--                (c) University Tuebingen 2011
-- License     :  BSD-style (see the file libraries/base/LICENSE)
-- Maintainer  :  libraries@haskell.org
-- Stability   :  experimental
-- Portability :  portable
--
-- Monadic zipping (used for monad comprehensions)
--
-----------------------------------------------------------------------------

module Control.Monad.Zip where

import Control.Monad (liftM, liftM2)
import Data.Functor.Identity
import Data.Monoid
import Data.Ord ( Down(..) )
import Data.Proxy
import qualified Data.List.NonEmpty as NE
import GHC.Generics

-- | Instances should satisfy the laws:
--
-- [Naturality]
--
--     @'liftM' (f 'Control.Arrow.***' g) ('mzip' ma mb)
--         = 'mzip' ('liftM' f ma) ('liftM' g mb)@
--
-- [Information Preservation]
--
--     @'liftM' ('Prelude.const' ()) ma = 'liftM' ('Prelude.const' ()) mb@
--         implies
--     @'munzip' ('mzip' ma mb) = (ma, mb)@
--
class Monad m => MonadZip m where
    {-# MINIMAL mzip | mzipWith #-}

    mzip :: m a -> m b -> m (a,b)
    mzip = (a -> b -> (a, b)) -> m a -> m b -> m (a, b)
forall (m :: * -> *) a b c.
MonadZip m =>
(a -> b -> c) -> m a -> m b -> m c
mzipWith (,)

    mzipWith :: (a -> b -> c) -> m a -> m b -> m c
    mzipWith f :: a -> b -> c
f ma :: m a
ma mb :: m b
mb = ((a, b) -> c) -> m (a, b) -> m c
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((a -> b -> c) -> (a, b) -> c
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> b -> c
f) (m a -> m b -> m (a, b)
forall (m :: * -> *) a b. MonadZip m => m a -> m b -> m (a, b)
mzip m a
ma m b
mb)

    munzip :: m (a,b) -> (m a, m b)
    munzip mab :: m (a, b)
mab = (((a, b) -> a) -> m (a, b) -> m a
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (a, b) -> a
forall a b. (a, b) -> a
fst m (a, b)
mab, ((a, b) -> b) -> m (a, b) -> m b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (a, b) -> b
forall a b. (a, b) -> b
snd m (a, b)
mab)
    -- munzip is a member of the class because sometimes
    -- you can implement it more efficiently than the
    -- above default code.  See Trac #4370 comment by giorgidze

-- | @since 4.3.1.0
instance MonadZip [] where
    mzip :: [a] -> [b] -> [(a, b)]
mzip     = [a] -> [b] -> [(a, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip
    mzipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
mzipWith = (a -> b -> c) -> [a] -> [b] -> [c]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
    munzip :: [(a, b)] -> ([a], [b])
munzip   = [(a, b)] -> ([a], [b])
forall a b. [(a, b)] -> ([a], [b])
unzip

-- | @since 4.9.0.0
instance MonadZip NE.NonEmpty where
  mzip :: NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
mzip     = NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
NE.zip
  mzipWith :: (a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
mzipWith = (a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
forall a b c.
(a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
NE.zipWith
  munzip :: NonEmpty (a, b) -> (NonEmpty a, NonEmpty b)
munzip   = NonEmpty (a, b) -> (NonEmpty a, NonEmpty b)
forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
NE.unzip

-- | @since 4.8.0.0
instance MonadZip Identity where
    mzipWith :: (a -> b -> c) -> Identity a -> Identity b -> Identity c
mzipWith                 = (a -> b -> c) -> Identity a -> Identity b -> Identity c
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2
    munzip :: Identity (a, b) -> (Identity a, Identity b)
munzip (Identity (a :: a
a, b :: b
b)) = (a -> Identity a
forall a. a -> Identity a
Identity a
a, b -> Identity b
forall a. a -> Identity a
Identity b
b)

-- | @since 4.8.0.0
instance MonadZip Dual where
    -- Cannot use coerce, it's unsafe
    mzipWith :: (a -> b -> c) -> Dual a -> Dual b -> Dual c
mzipWith = (a -> b -> c) -> Dual a -> Dual b -> Dual c
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2

-- | @since 4.8.0.0
instance MonadZip Sum where
    mzipWith :: (a -> b -> c) -> Sum a -> Sum b -> Sum c
mzipWith = (a -> b -> c) -> Sum a -> Sum b -> Sum c
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2

-- | @since 4.8.0.0
instance MonadZip Product where
    mzipWith :: (a -> b -> c) -> Product a -> Product b -> Product c
mzipWith = (a -> b -> c) -> Product a -> Product b -> Product c
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2

-- | @since 4.8.0.0
instance MonadZip Maybe where
    mzipWith :: (a -> b -> c) -> Maybe a -> Maybe b -> Maybe c
mzipWith = (a -> b -> c) -> Maybe a -> Maybe b -> Maybe c
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2

-- | @since 4.8.0.0
instance MonadZip First where
    mzipWith :: (a -> b -> c) -> First a -> First b -> First c
mzipWith = (a -> b -> c) -> First a -> First b -> First c
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2

-- | @since 4.8.0.0
instance MonadZip Last where
    mzipWith :: (a -> b -> c) -> Last a -> Last b -> Last c
mzipWith = (a -> b -> c) -> Last a -> Last b -> Last c
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2

-- | @since 4.8.0.0
instance MonadZip f => MonadZip (Alt f) where
    mzipWith :: (a -> b -> c) -> Alt f a -> Alt f b -> Alt f c
mzipWith f :: a -> b -> c
f (Alt ma :: f a
ma) (Alt mb :: f b
mb) = f c -> Alt f c
forall k (f :: k -> *) (a :: k). f a -> Alt f a
Alt ((a -> b -> c) -> f a -> f b -> f c
forall (m :: * -> *) a b c.
MonadZip m =>
(a -> b -> c) -> m a -> m b -> m c
mzipWith a -> b -> c
f f a
ma f b
mb)

-- | @since 4.9.0.0
instance MonadZip Proxy where
    mzipWith :: (a -> b -> c) -> Proxy a -> Proxy b -> Proxy c
mzipWith _ _ _ = Proxy c
forall k (t :: k). Proxy t
Proxy

-- Instances for GHC.Generics
-- | @since 4.9.0.0
instance MonadZip U1 where
    mzipWith :: (a -> b -> c) -> U1 a -> U1 b -> U1 c
mzipWith _ _ _ = U1 c
forall k (p :: k). U1 p
U1

-- | @since 4.9.0.0
instance MonadZip Par1 where
    mzipWith :: (a -> b -> c) -> Par1 a -> Par1 b -> Par1 c
mzipWith = (a -> b -> c) -> Par1 a -> Par1 b -> Par1 c
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2

-- | @since 4.9.0.0
instance MonadZip f => MonadZip (Rec1 f) where
    mzipWith :: (a -> b -> c) -> Rec1 f a -> Rec1 f b -> Rec1 f c
mzipWith f :: a -> b -> c
f (Rec1 fa :: f a
fa) (Rec1 fb :: f b
fb) = f c -> Rec1 f c
forall k (f :: k -> *) (p :: k). f p -> Rec1 f p
Rec1 ((a -> b -> c) -> f a -> f b -> f c
forall (m :: * -> *) a b c.
MonadZip m =>
(a -> b -> c) -> m a -> m b -> m c
mzipWith a -> b -> c
f f a
fa f b
fb)

-- | @since 4.9.0.0
instance MonadZip f => MonadZip (M1 i c f) where
    mzipWith :: (a -> b -> c) -> M1 i c f a -> M1 i c f b -> M1 i c f c
mzipWith f :: a -> b -> c
f (M1 fa :: f a
fa) (M1 fb :: f b
fb) = f c -> M1 i c f c
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 ((a -> b -> c) -> f a -> f b -> f c
forall (m :: * -> *) a b c.
MonadZip m =>
(a -> b -> c) -> m a -> m b -> m c
mzipWith a -> b -> c
f f a
fa f b
fb)

-- | @since 4.9.0.0
instance (MonadZip f, MonadZip g) => MonadZip (f :*: g) where
    mzipWith :: (a -> b -> c) -> (:*:) f g a -> (:*:) f g b -> (:*:) f g c
mzipWith f :: a -> b -> c
f (x1 :: f a
x1 :*: y1 :: g a
y1) (x2 :: f b
x2 :*: y2 :: g b
y2) = (a -> b -> c) -> f a -> f b -> f c
forall (m :: * -> *) a b c.
MonadZip m =>
(a -> b -> c) -> m a -> m b -> m c
mzipWith a -> b -> c
f f a
x1 f b
x2 f c -> g c -> (:*:) f g c
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: (a -> b -> c) -> g a -> g b -> g c
forall (m :: * -> *) a b c.
MonadZip m =>
(a -> b -> c) -> m a -> m b -> m c
mzipWith a -> b -> c
f g a
y1 g b
y2

-- instances for Data.Ord

-- | @since 4.12.0.0
instance MonadZip Down where
    mzipWith :: (a -> b -> c) -> Down a -> Down b -> Down c
mzipWith = (a -> b -> c) -> Down a -> Down b -> Down c
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2