{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}

-----------------------------------------------------------------------------
-- |
-- Copyright   :  (C) 2008-2016 Jesse Selover, Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  provisional
-- Portability :  portable
--
-- The product of two bifunctors.
----------------------------------------------------------------------------
module Data.Bifunctor.Product
  ( Product(..)
  ) where

import qualified Control.Arrow as A
import Control.Category
import Data.Biapplicative
import Data.Bifoldable
import Data.Bifoldable1 (Bifoldable1(..))
import Data.Bifunctor.Functor
import Data.Bitraversable
import Data.Functor.Classes
import qualified Data.Semigroup as S
import GHC.Generics

import Prelude hiding ((.),id)

-- | Form the product of two bifunctors
data Product f g a b = Pair (f a b) (g a b)
  deriving (Product f g a b -> Product f g a b -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k k (f :: k -> k -> *) (g :: k -> k -> *) (a :: k) (b :: k).
(Eq (f a b), Eq (g a b)) =>
Product f g a b -> Product f g a b -> Bool
/= :: Product f g a b -> Product f g a b -> Bool
$c/= :: forall k k (f :: k -> k -> *) (g :: k -> k -> *) (a :: k) (b :: k).
(Eq (f a b), Eq (g a b)) =>
Product f g a b -> Product f g a b -> Bool
== :: Product f g a b -> Product f g a b -> Bool
$c== :: forall k k (f :: k -> k -> *) (g :: k -> k -> *) (a :: k) (b :: k).
(Eq (f a b), Eq (g a b)) =>
Product f g a b -> Product f g a b -> Bool
Eq, Product f g a b -> Product f g a b -> Bool
Product f g a b -> Product f g a b -> Ordering
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 {k} {k} {f :: k -> k -> *} {g :: k -> k -> *} {a :: k}
       {b :: k}.
(Ord (f a b), Ord (g a b)) =>
Eq (Product f g a b)
forall k k (f :: k -> k -> *) (g :: k -> k -> *) (a :: k) (b :: k).
(Ord (f a b), Ord (g a b)) =>
Product f g a b -> Product f g a b -> Bool
forall k k (f :: k -> k -> *) (g :: k -> k -> *) (a :: k) (b :: k).
(Ord (f a b), Ord (g a b)) =>
Product f g a b -> Product f g a b -> Ordering
forall k k (f :: k -> k -> *) (g :: k -> k -> *) (a :: k) (b :: k).
(Ord (f a b), Ord (g a b)) =>
Product f g a b -> Product f g a b -> Product f g a b
min :: Product f g a b -> Product f g a b -> Product f g a b
$cmin :: forall k k (f :: k -> k -> *) (g :: k -> k -> *) (a :: k) (b :: k).
(Ord (f a b), Ord (g a b)) =>
Product f g a b -> Product f g a b -> Product f g a b
max :: Product f g a b -> Product f g a b -> Product f g a b
$cmax :: forall k k (f :: k -> k -> *) (g :: k -> k -> *) (a :: k) (b :: k).
(Ord (f a b), Ord (g a b)) =>
Product f g a b -> Product f g a b -> Product f g a b
>= :: Product f g a b -> Product f g a b -> Bool
$c>= :: forall k k (f :: k -> k -> *) (g :: k -> k -> *) (a :: k) (b :: k).
(Ord (f a b), Ord (g a b)) =>
Product f g a b -> Product f g a b -> Bool
> :: Product f g a b -> Product f g a b -> Bool
$c> :: forall k k (f :: k -> k -> *) (g :: k -> k -> *) (a :: k) (b :: k).
(Ord (f a b), Ord (g a b)) =>
Product f g a b -> Product f g a b -> Bool
<= :: Product f g a b -> Product f g a b -> Bool
$c<= :: forall k k (f :: k -> k -> *) (g :: k -> k -> *) (a :: k) (b :: k).
(Ord (f a b), Ord (g a b)) =>
Product f g a b -> Product f g a b -> Bool
< :: Product f g a b -> Product f g a b -> Bool
$c< :: forall k k (f :: k -> k -> *) (g :: k -> k -> *) (a :: k) (b :: k).
(Ord (f a b), Ord (g a b)) =>
Product f g a b -> Product f g a b -> Bool
compare :: Product f g a b -> Product f g a b -> Ordering
$ccompare :: forall k k (f :: k -> k -> *) (g :: k -> k -> *) (a :: k) (b :: k).
(Ord (f a b), Ord (g a b)) =>
Product f g a b -> Product f g a b -> Ordering
Ord, Int -> Product f g a b -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k k (f :: k -> k -> *) (g :: k -> k -> *) (a :: k) (b :: k).
(Show (f a b), Show (g a b)) =>
Int -> Product f g a b -> ShowS
forall k k (f :: k -> k -> *) (g :: k -> k -> *) (a :: k) (b :: k).
(Show (f a b), Show (g a b)) =>
[Product f g a b] -> ShowS
forall k k (f :: k -> k -> *) (g :: k -> k -> *) (a :: k) (b :: k).
(Show (f a b), Show (g a b)) =>
Product f g a b -> String
showList :: [Product f g a b] -> ShowS
$cshowList :: forall k k (f :: k -> k -> *) (g :: k -> k -> *) (a :: k) (b :: k).
(Show (f a b), Show (g a b)) =>
[Product f g a b] -> ShowS
show :: Product f g a b -> String
$cshow :: forall k k (f :: k -> k -> *) (g :: k -> k -> *) (a :: k) (b :: k).
(Show (f a b), Show (g a b)) =>
Product f g a b -> String
showsPrec :: Int -> Product f g a b -> ShowS
$cshowsPrec :: forall k k (f :: k -> k -> *) (g :: k -> k -> *) (a :: k) (b :: k).
(Show (f a b), Show (g a b)) =>
Int -> Product f g a b -> ShowS
Show, ReadPrec [Product f g a b]
ReadPrec (Product f g a b)
ReadS [Product f g a b]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall k k (f :: k -> k -> *) (g :: k -> k -> *) (a :: k) (b :: k).
(Read (f a b), Read (g a b)) =>
ReadPrec [Product f g a b]
forall k k (f :: k -> k -> *) (g :: k -> k -> *) (a :: k) (b :: k).
(Read (f a b), Read (g a b)) =>
ReadPrec (Product f g a b)
forall k k (f :: k -> k -> *) (g :: k -> k -> *) (a :: k) (b :: k).
(Read (f a b), Read (g a b)) =>
Int -> ReadS (Product f g a b)
forall k k (f :: k -> k -> *) (g :: k -> k -> *) (a :: k) (b :: k).
(Read (f a b), Read (g a b)) =>
ReadS [Product f g a b]
readListPrec :: ReadPrec [Product f g a b]
$creadListPrec :: forall k k (f :: k -> k -> *) (g :: k -> k -> *) (a :: k) (b :: k).
(Read (f a b), Read (g a b)) =>
ReadPrec [Product f g a b]
readPrec :: ReadPrec (Product f g a b)
$creadPrec :: forall k k (f :: k -> k -> *) (g :: k -> k -> *) (a :: k) (b :: k).
(Read (f a b), Read (g a b)) =>
ReadPrec (Product f g a b)
readList :: ReadS [Product f g a b]
$creadList :: forall k k (f :: k -> k -> *) (g :: k -> k -> *) (a :: k) (b :: k).
(Read (f a b), Read (g a b)) =>
ReadS [Product f g a b]
readsPrec :: Int -> ReadS (Product f g a b)
$creadsPrec :: forall k k (f :: k -> k -> *) (g :: k -> k -> *) (a :: k) (b :: k).
(Read (f a b), Read (g a b)) =>
Int -> ReadS (Product f g a b)
Read, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k k (f :: k -> k -> *) (g :: k -> k -> *) (a :: k) (b :: k)
       x.
Rep (Product f g a b) x -> Product f g a b
forall k k (f :: k -> k -> *) (g :: k -> k -> *) (a :: k) (b :: k)
       x.
Product f g a b -> Rep (Product f g a b) x
$cto :: forall k k (f :: k -> k -> *) (g :: k -> k -> *) (a :: k) (b :: k)
       x.
Rep (Product f g a b) x -> Product f g a b
$cfrom :: forall k k (f :: k -> k -> *) (g :: k -> k -> *) (a :: k) (b :: k)
       x.
Product f g a b -> Rep (Product f g a b) x
Generic, forall k k (f :: k -> k -> *) (g :: k -> k -> *) (a :: k) (a :: k).
Rep1 (Product f g a) a -> Product f g a a
forall k k (f :: k -> k -> *) (g :: k -> k -> *) (a :: k) (a :: k).
Product f g a a -> Rep1 (Product f g a) a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall k k (f :: k -> k -> *) (g :: k -> k -> *) (a :: k) (a :: k).
Rep1 (Product f g a) a -> Product f g a a
$cfrom1 :: forall k k (f :: k -> k -> *) (g :: k -> k -> *) (a :: k) (a :: k).
Product f g a a -> Rep1 (Product f g a) a
Generic1)
deriving instance (Functor (f a), Functor (g a)) => Functor (Product f g a)
deriving instance (Foldable (f a), Foldable (g a)) => Foldable (Product f g a)
deriving instance (Traversable (f a), Traversable (g a)) => Traversable (Product f g a)

instance (Eq2 f, Eq2 g, Eq a) => Eq1 (Product f g a) where
  liftEq :: forall a b.
(a -> b -> Bool) -> Product f g a a -> Product f g a b -> Bool
liftEq = forall (f :: * -> * -> *) a b c d.
Eq2 f =>
(a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
liftEq2 forall a. Eq a => a -> a -> Bool
(==)
instance (Eq2 f, Eq2 g) => Eq2 (Product f g) where
  liftEq2 :: forall a b c d.
(a -> b -> Bool)
-> (c -> d -> Bool) -> Product f g a c -> Product f g b d -> Bool
liftEq2 a -> b -> Bool
f c -> d -> Bool
g (Pair f a c
x1 g a c
y1) (Pair f b d
x2 g b d
y2) =
    forall (f :: * -> * -> *) a b c d.
Eq2 f =>
(a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
liftEq2 a -> b -> Bool
f c -> d -> Bool
g f a c
x1 f b d
x2 Bool -> Bool -> Bool
&& forall (f :: * -> * -> *) a b c d.
Eq2 f =>
(a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
liftEq2 a -> b -> Bool
f c -> d -> Bool
g g a c
y1 g b d
y2

instance (Ord2 f, Ord2 g, Ord a) => Ord1 (Product f g a) where
  liftCompare :: forall a b.
(a -> b -> Ordering)
-> Product f g a a -> Product f g a b -> Ordering
liftCompare = forall (f :: * -> * -> *) a b c d.
Ord2 f =>
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> f a c -> f b d -> Ordering
liftCompare2 forall a. Ord a => a -> a -> Ordering
compare
instance (Ord2 f, Ord2 g) => Ord2 (Product f g) where
  liftCompare2 :: forall a b c d.
(a -> b -> Ordering)
-> (c -> d -> Ordering)
-> Product f g a c
-> Product f g b d
-> Ordering
liftCompare2 a -> b -> Ordering
f c -> d -> Ordering
g (Pair f a c
x1 g a c
y1) (Pair f b d
x2 g b d
y2) =
    forall (f :: * -> * -> *) a b c d.
Ord2 f =>
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> f a c -> f b d -> Ordering
liftCompare2 a -> b -> Ordering
f c -> d -> Ordering
g f a c
x1 f b d
x2 forall a. Monoid a => a -> a -> a
`mappend` forall (f :: * -> * -> *) a b c d.
Ord2 f =>
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> f a c -> f b d -> Ordering
liftCompare2 a -> b -> Ordering
f c -> d -> Ordering
g g a c
y1 g b d
y2

instance (Read2 f, Read2 g, Read a) => Read1 (Product f g a) where
  liftReadsPrec :: forall a.
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (Product f g a a)
liftReadsPrec = forall (f :: * -> * -> *) a b.
Read2 f =>
(Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (f a b)
liftReadsPrec2 forall a. Read a => Int -> ReadS a
readsPrec forall a. Read a => ReadS [a]
readList
instance (Read2 f, Read2 g) => Read2 (Product f g) where
  liftReadsPrec2 :: forall a b.
(Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (Product f g a b)
liftReadsPrec2 Int -> ReadS a
rp1 ReadS [a]
rl1 Int -> ReadS b
rp2 ReadS [b]
rl2 = forall a. (String -> ReadS a) -> Int -> ReadS a
readsData forall a b. (a -> b) -> a -> b
$
    forall a b t.
(Int -> ReadS a)
-> (Int -> ReadS b) -> String -> (a -> b -> t) -> String -> ReadS t
readsBinaryWith (forall (f :: * -> * -> *) a b.
Read2 f =>
(Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (f a b)
liftReadsPrec2 Int -> ReadS a
rp1 ReadS [a]
rl1 Int -> ReadS b
rp2 ReadS [b]
rl2)
                    (forall (f :: * -> * -> *) a b.
Read2 f =>
(Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (f a b)
liftReadsPrec2 Int -> ReadS a
rp1 ReadS [a]
rl1 Int -> ReadS b
rp2 ReadS [b]
rl2)
                    String
"Pair" forall {k} {k} (f :: k -> k -> *) (g :: k -> k -> *) (a :: k)
       (b :: k).
f a b -> g a b -> Product f g a b
Pair

instance (Show2 f, Show2 g, Show a) => Show1 (Product f g a) where
  liftShowsPrec :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> Product f g a a -> ShowS
liftShowsPrec = forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 forall a. Show a => Int -> a -> ShowS
showsPrec forall a. Show a => [a] -> ShowS
showList
instance (Show2 f, Show2 g) => Show2 (Product f g) where
  liftShowsPrec2 :: forall a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> Product f g a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
sp1 [a] -> ShowS
sl1 Int -> b -> ShowS
sp2 [b] -> ShowS
sl2 Int
p (Pair f a b
x g a b
y) =
    forall a b.
(Int -> a -> ShowS)
-> (Int -> b -> ShowS) -> String -> Int -> a -> b -> ShowS
showsBinaryWith (forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
sp1 [a] -> ShowS
sl1 Int -> b -> ShowS
sp2 [b] -> ShowS
sl2)
                    (forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
sp1 [a] -> ShowS
sl1 Int -> b -> ShowS
sp2 [b] -> ShowS
sl2)
                    String
"Pair" Int
p f a b
x g a b
y

instance (Bifunctor f, Bifunctor g) => Bifunctor (Product f g) where
  first :: forall a b c. (a -> b) -> Product f g a c -> Product f g b c
first a -> b
f (Pair f a c
x g a c
y) = forall {k} {k} (f :: k -> k -> *) (g :: k -> k -> *) (a :: k)
       (b :: k).
f a b -> g a b -> Product f g a b
Pair (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first a -> b
f f a c
x) (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first a -> b
f g a c
y)
  {-# INLINE first #-}
  second :: forall b c a. (b -> c) -> Product f g a b -> Product f g a c
second b -> c
g (Pair f a b
x g a b
y) = forall {k} {k} (f :: k -> k -> *) (g :: k -> k -> *) (a :: k)
       (b :: k).
f a b -> g a b -> Product f g a b
Pair (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second b -> c
g f a b
x) (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second b -> c
g g a b
y)
  {-# INLINE second #-}
  bimap :: forall a b c d.
(a -> b) -> (c -> d) -> Product f g a c -> Product f g b d
bimap a -> b
f c -> d
g (Pair f a c
x g a c
y) = forall {k} {k} (f :: k -> k -> *) (g :: k -> k -> *) (a :: k)
       (b :: k).
f a b -> g a b -> Product f g a b
Pair (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
f c -> d
g f a c
x) (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
f c -> d
g g a c
y)
  {-# INLINE bimap #-}

instance (Biapplicative f, Biapplicative g) => Biapplicative (Product f g) where
  bipure :: forall a b. a -> b -> Product f g a b
bipure a
a b
b = forall {k} {k} (f :: k -> k -> *) (g :: k -> k -> *) (a :: k)
       (b :: k).
f a b -> g a b -> Product f g a b
Pair (forall (p :: * -> * -> *) a b. Biapplicative p => a -> b -> p a b
bipure a
a b
b) (forall (p :: * -> * -> *) a b. Biapplicative p => a -> b -> p a b
bipure a
a b
b)
  {-# INLINE bipure #-}
  Pair f (a -> b) (c -> d)
w g (a -> b) (c -> d)
x <<*>> :: forall a b c d.
Product f g (a -> b) (c -> d) -> Product f g a c -> Product f g b d
<<*>> Pair f a c
y g a c
z = forall {k} {k} (f :: k -> k -> *) (g :: k -> k -> *) (a :: k)
       (b :: k).
f a b -> g a b -> Product f g a b
Pair (f (a -> b) (c -> d)
w forall (p :: * -> * -> *) a b c d.
Biapplicative p =>
p (a -> b) (c -> d) -> p a c -> p b d
<<*>> f a c
y) (g (a -> b) (c -> d)
x forall (p :: * -> * -> *) a b c d.
Biapplicative p =>
p (a -> b) (c -> d) -> p a c -> p b d
<<*>> g a c
z)
  {-# INLINE (<<*>>) #-}

instance (Bifoldable f, Bifoldable g) => Bifoldable (Product f g) where
  bifoldMap :: forall m a b.
Monoid m =>
(a -> m) -> (b -> m) -> Product f g a b -> m
bifoldMap a -> m
f b -> m
g (Pair f a b
x g a b
y) = forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap a -> m
f b -> m
g f a b
x forall a. Monoid a => a -> a -> a
`mappend` forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap a -> m
f b -> m
g g a b
y
  {-# INLINE bifoldMap #-}

instance (Bifoldable1 f, Bifoldable1 g) => Bifoldable1 (Product f g) where
  bifoldMap1 :: forall m a b.
Semigroup m =>
(a -> m) -> (b -> m) -> Product f g a b -> m
bifoldMap1 a -> m
f b -> m
g (Pair f a b
x g a b
y) = forall (t :: * -> * -> *) m a b.
(Bifoldable1 t, Semigroup m) =>
(a -> m) -> (b -> m) -> t a b -> m
bifoldMap1 a -> m
f b -> m
g f a b
x forall a. Semigroup a => a -> a -> a
S.<> forall (t :: * -> * -> *) m a b.
(Bifoldable1 t, Semigroup m) =>
(a -> m) -> (b -> m) -> t a b -> m
bifoldMap1 a -> m
f b -> m
g g a b
y
  {-# INLINE bifoldMap1 #-}

instance (Bitraversable f, Bitraversable g) => Bitraversable (Product f g) where
  bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Product f g a b -> f (Product f g c d)
bitraverse a -> f c
f b -> f d
g (Pair f a b
x g a b
y) = forall {k} {k} (f :: k -> k -> *) (g :: k -> k -> *) (a :: k)
       (b :: k).
f a b -> g a b -> Product f g a b
Pair forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f c
f b -> f d
g f a b
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f c
f b -> f d
g g a b
y
  {-# INLINE bitraverse #-}

instance BifunctorFunctor (Product p) where
  bifmap :: forall (p :: k -> k -> *) (q :: k -> k -> *).
(p :-> q) -> Product p p :-> Product p q
bifmap p :-> q
f (Pair p a b
p p a b
q) = forall {k} {k} (f :: k -> k -> *) (g :: k -> k -> *) (a :: k)
       (b :: k).
f a b -> g a b -> Product f g a b
Pair p a b
p (p :-> q
f p a b
q)

instance BifunctorComonad (Product p) where
  biextract :: forall (p :: k -> k -> *). Product p p :-> p
biextract (Pair p a b
_ p a b
q) = p a b
q
  biduplicate :: forall (p :: k -> k -> *). Product p p :-> Product p (Product p p)
biduplicate pq :: Product p p a b
pq@(Pair p a b
p p a b
_) = forall {k} {k} (f :: k -> k -> *) (g :: k -> k -> *) (a :: k)
       (b :: k).
f a b -> g a b -> Product f g a b
Pair p a b
p Product p p a b
pq
  biextend :: forall (p :: k -> k -> *) (q :: k -> k -> *).
(Product p p :-> q) -> Product p p :-> Product p q
biextend Product p p :-> q
f pq :: Product p p a b
pq@(Pair p a b
p p a b
_) = forall {k} {k} (f :: k -> k -> *) (g :: k -> k -> *) (a :: k)
       (b :: k).
f a b -> g a b -> Product f g a b
Pair p a b
p (Product p p :-> q
f Product p p a b
pq)

instance (Category p, Category q) => Category (Product p q) where
  id :: forall (a :: k). Product p q a a
id = forall {k} {k} (f :: k -> k -> *) (g :: k -> k -> *) (a :: k)
       (b :: k).
f a b -> g a b -> Product f g a b
Pair forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
  Pair p b c
x q b c
y . :: forall (b :: k) (c :: k) (a :: k).
Product p q b c -> Product p q a b -> Product p q a c
. Pair p a b
x' q a b
y' = forall {k} {k} (f :: k -> k -> *) (g :: k -> k -> *) (a :: k)
       (b :: k).
f a b -> g a b -> Product f g a b
Pair (p b c
x forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. p a b
x') (q b c
y forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. q a b
y')

instance (A.Arrow p, A.Arrow q) => A.Arrow (Product p q) where
  arr :: forall b c. (b -> c) -> Product p q b c
arr b -> c
f = forall {k} {k} (f :: k -> k -> *) (g :: k -> k -> *) (a :: k)
       (b :: k).
f a b -> g a b -> Product f g a b
Pair (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
A.arr b -> c
f) (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
A.arr b -> c
f)
  first :: forall b c d. Product p q b c -> Product p q (b, d) (c, d)
first (Pair p b c
x q b c
y) = forall {k} {k} (f :: k -> k -> *) (g :: k -> k -> *) (a :: k)
       (b :: k).
f a b -> g a b -> Product f g a b
Pair (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first p b c
x) (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first q b c
y)
  second :: forall b c d. Product p q b c -> Product p q (d, b) (d, c)
second (Pair p b c
x q b c
y) = forall {k} {k} (f :: k -> k -> *) (g :: k -> k -> *) (a :: k)
       (b :: k).
f a b -> g a b -> Product f g a b
Pair (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
A.second p b c
x) (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
A.second q b c
y)
  Pair p b c
x q b c
y *** :: forall b c b' c'.
Product p q b c -> Product p q b' c' -> Product p q (b, b') (c, c')
*** Pair p b' c'
x' q b' c'
y' = forall {k} {k} (f :: k -> k -> *) (g :: k -> k -> *) (a :: k)
       (b :: k).
f a b -> g a b -> Product f g a b
Pair (p b c
x forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
A.*** p b' c'
x') (q b c
y forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
A.*** q b' c'
y')
  Pair p b c
x q b c
y &&& :: forall b c c'.
Product p q b c -> Product p q b c' -> Product p q b (c, c')
&&& Pair p b c'
x' q b c'
y' = forall {k} {k} (f :: k -> k -> *) (g :: k -> k -> *) (a :: k)
       (b :: k).
f a b -> g a b -> Product f g a b
Pair (p b c
x forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
A.&&& p b c'
x') (q b c
y forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
A.&&& q b c'
y')

instance (A.ArrowChoice p, A.ArrowChoice q) => A.ArrowChoice (Product p q) where
  left :: forall b c d.
Product p q b c -> Product p q (Either b d) (Either c d)
left (Pair p b c
x q b c
y) = forall {k} {k} (f :: k -> k -> *) (g :: k -> k -> *) (a :: k)
       (b :: k).
f a b -> g a b -> Product f g a b
Pair (forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
A.left p b c
x) (forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
A.left q b c
y)
  right :: forall b c d.
Product p q b c -> Product p q (Either d b) (Either d c)
right (Pair p b c
x q b c
y) = forall {k} {k} (f :: k -> k -> *) (g :: k -> k -> *) (a :: k)
       (b :: k).
f a b -> g a b -> Product f g a b
Pair (forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either d b) (Either d c)
A.right p b c
x) (forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either d b) (Either d c)
A.right q b c
y)
  Pair p b c
x q b c
y +++ :: forall b c b' c'.
Product p q b c
-> Product p q b' c' -> Product p q (Either b b') (Either c c')
+++ Pair p b' c'
x' q b' c'
y' = forall {k} {k} (f :: k -> k -> *) (g :: k -> k -> *) (a :: k)
       (b :: k).
f a b -> g a b -> Product f g a b
Pair (p b c
x forall (a :: * -> * -> *) b c b' c'.
ArrowChoice a =>
a b c -> a b' c' -> a (Either b b') (Either c c')
A.+++ p b' c'
x') (q b c
y forall (a :: * -> * -> *) b c b' c'.
ArrowChoice a =>
a b c -> a b' c' -> a (Either b b') (Either c c')
A.+++ q b' c'
y')
  Pair p b d
x q b d
y ||| :: forall b d c.
Product p q b d -> Product p q c d -> Product p q (Either b c) d
||| Pair p c d
x' q c d
y' = forall {k} {k} (f :: k -> k -> *) (g :: k -> k -> *) (a :: k)
       (b :: k).
f a b -> g a b -> Product f g a b
Pair (p b d
x forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
A.||| p c d
x') (q b d
y forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
A.||| q c d
y')

instance (A.ArrowLoop p, A.ArrowLoop q) => A.ArrowLoop (Product p q) where
  loop :: forall b d c. Product p q (b, d) (c, d) -> Product p q b c
loop (Pair p (b, d) (c, d)
x q (b, d) (c, d)
y) = forall {k} {k} (f :: k -> k -> *) (g :: k -> k -> *) (a :: k)
       (b :: k).
f a b -> g a b -> Product f g a b
Pair (forall (a :: * -> * -> *) b d c.
ArrowLoop a =>
a (b, d) (c, d) -> a b c
A.loop p (b, d) (c, d)
x) (forall (a :: * -> * -> *) b d c.
ArrowLoop a =>
a (b, d) (c, d) -> a b c
A.loop q (b, d) (c, d)
y)

instance (A.ArrowZero p, A.ArrowZero q) => A.ArrowZero (Product p q) where
  zeroArrow :: forall b c. Product p q b c
zeroArrow = forall {k} {k} (f :: k -> k -> *) (g :: k -> k -> *) (a :: k)
       (b :: k).
f a b -> g a b -> Product f g a b
Pair forall (a :: * -> * -> *) b c. ArrowZero a => a b c
A.zeroArrow forall (a :: * -> * -> *) b c. ArrowZero a => a b c
A.zeroArrow

instance (A.ArrowPlus p, A.ArrowPlus q) => A.ArrowPlus (Product p q) where
  Pair p b c
x q b c
y <+> :: forall b c. Product p q b c -> Product p q b c -> Product p q b c
<+> Pair p b c
x' q b c
y' = forall {k} {k} (f :: k -> k -> *) (g :: k -> k -> *) (a :: k)
       (b :: k).
f a b -> g a b -> Product f g a b
Pair (p b c
x forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
A.<+> p b c
x') (q b c
y forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
A.<+> q b c
y')