{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE TypeFamilies #-}

#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE DeriveGeneric #-}
#endif

#if __GLASGOW_HASKELL__ >= 706
{-# LANGUAGE PolyKinds #-}
#endif

#if __GLASGOW_HASKELL__ >= 708
{-# LANGUAGE Safe #-}
#elif __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif
#include "bifunctors-common.h"

-----------------------------------------------------------------------------
-- |
-- 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

#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
#endif

import qualified Control.Arrow as A
import Control.Category
import Data.Biapplicative
import Data.Bifoldable
import Data.Bifunctor.Functor
import Data.Bitraversable

#if __GLASGOW_HASKELL__ < 710
import Data.Monoid hiding (Product)
#endif

#if __GLASGOW_HASKELL__ >= 708
import Data.Typeable
#endif

#if __GLASGOW_HASKELL__ >= 702
import GHC.Generics
#endif

#if LIFTED_FUNCTOR_CLASSES
import Data.Functor.Classes
#endif

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
(Product f g a b -> Product f g a b -> Bool)
-> (Product f g a b -> Product f g a b -> Bool)
-> Eq (Product f g a b)
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, Eq (Product f g a b)
Eq (Product f g a b)
-> (Product f g a b -> Product f g a b -> Ordering)
-> (Product f g a b -> Product f g a b -> Bool)
-> (Product f g a b -> Product f g a b -> Bool)
-> (Product f g a b -> Product f g a b -> Bool)
-> (Product f g a b -> Product f g a b -> Bool)
-> (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 -> Product f g a b)
-> Ord (Product f g a b)
Product f g a b -> Product f g a b -> Bool
Product f g a b -> Product f g a b -> Ordering
Product f g a b -> Product f g a b -> Product f g a b
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
$cp1Ord :: 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)
Ord, Int -> Product f g a b -> ShowS
[Product f g a b] -> ShowS
Product f g a b -> String
(Int -> Product f g a b -> ShowS)
-> (Product f g a b -> String)
-> ([Product f g a b] -> ShowS)
-> Show (Product f g a b)
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)
Int -> ReadS (Product f g a b)
ReadS [Product f g a b]
(Int -> ReadS (Product f g a b))
-> ReadS [Product f g a b]
-> ReadPrec (Product f g a b)
-> ReadPrec [Product f g a b]
-> Read (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
#if __GLASGOW_HASKELL__ >= 702
           , (forall x. Product f g a b -> Rep (Product f g a b) x)
-> (forall x. Rep (Product f g a b) x -> Product f g a b)
-> Generic (Product f g a b)
forall x. Rep (Product f g a b) x -> Product f g a b
forall x. Product f g a b -> Rep (Product f g a b) x
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
#endif
#if __GLASGOW_HASKELL__ >= 708
           , (forall (a :: k). Product f g a a -> Rep1 (Product f g a) a)
-> (forall (a :: k). Rep1 (Product f g a) a -> Product f g a a)
-> Generic1 (Product f g a)
forall (a :: k). Rep1 (Product f g a) a -> Product f g a a
forall (a :: k). Product f g a a -> Rep1 (Product f g a) a
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
           , Typeable
#endif
           )

#if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ < 708
data ProductMetaData
data ProductMetaCons

instance Datatype ProductMetaData where
    datatypeName _ = "Product"
    moduleName _ = "Data.Bifunctor.Product"

instance Constructor ProductMetaCons where
    conName _ = "Pair"

instance Generic1 (Product f g a) where
    type Rep1 (Product f g a) = D1 ProductMetaData (C1 ProductMetaCons ((:*:)
        (S1 NoSelector (Rec1 (f a)))
        (S1 NoSelector (Rec1 (g a)))))
    from1 (Pair f g) = M1 (M1 (M1 (Rec1 f) :*: M1 (Rec1 g)))
    to1 (M1 (M1 (M1 f :*: M1 g))) = Pair (unRec1 f) (unRec1 g)
#endif

#if LIFTED_FUNCTOR_CLASSES
instance (Eq2 f, Eq2 g, Eq a) => Eq1 (Product f g a) where
  liftEq :: (a -> b -> Bool) -> Product f g a a -> Product f g a b -> Bool
liftEq = (a -> a -> Bool)
-> (a -> b -> Bool) -> Product f g a a -> Product f g a b -> Bool
forall (f :: * -> * -> *) a b c d.
Eq2 f =>
(a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
liftEq2 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance (Eq2 f, Eq2 g) => Eq2 (Product f g) where
  liftEq2 :: (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) =
    (a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> 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 f a c
x1 f b d
x2 Bool -> Bool -> Bool
&& (a -> b -> Bool) -> (c -> d -> Bool) -> g a c -> g b d -> 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 :: (a -> b -> Ordering)
-> Product f g a a -> Product f g a b -> Ordering
liftCompare = (a -> a -> Ordering)
-> (a -> b -> Ordering)
-> Product f g a a
-> Product f g a b
-> Ordering
forall (f :: * -> * -> *) a b c d.
Ord2 f =>
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> f a c -> f b d -> Ordering
liftCompare2 a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
instance (Ord2 f, Ord2 g) => Ord2 (Product f g) where
  liftCompare2 :: (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) =
    (a -> b -> Ordering)
-> (c -> d -> Ordering) -> f a c -> f b d -> Ordering
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 Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend` (a -> b -> Ordering)
-> (c -> d -> Ordering) -> g a c -> g b d -> Ordering
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 :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (Product f g a a)
liftReadsPrec = (Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS a)
-> ReadS [a]
-> Int
-> ReadS (Product f g a a)
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
forall a. Read a => Int -> ReadS a
readsPrec ReadS [a]
forall a. Read a => ReadS [a]
readList
instance (Read2 f, Read2 g) => Read2 (Product f g) where
  liftReadsPrec2 :: (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 = (String -> ReadS (Product f g a b))
-> Int -> ReadS (Product f g a b)
forall a. (String -> ReadS a) -> Int -> ReadS a
readsData ((String -> ReadS (Product f g a b))
 -> Int -> ReadS (Product f g a b))
-> (String -> ReadS (Product f g a b))
-> Int
-> ReadS (Product f g a b)
forall a b. (a -> b) -> a -> b
$
    (Int -> ReadS (f a b))
-> (Int -> ReadS (g a b))
-> String
-> (f a b -> g a b -> Product f g a b)
-> String
-> ReadS (Product f g a b)
forall a b t.
(Int -> ReadS a)
-> (Int -> ReadS b) -> String -> (a -> b -> t) -> String -> ReadS t
readsBinaryWith ((Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (f a b)
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)
                    ((Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (g a b)
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" f a b -> g a b -> Product f g 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

instance (Show2 f, Show2 g, Show a) => Show1 (Product f g a) where
  liftShowsPrec :: (Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> Product f g a a -> ShowS
liftShowsPrec = (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> Product f g a a
-> ShowS
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
forall a. Show a => Int -> a -> ShowS
showsPrec [a] -> ShowS
forall a. Show a => [a] -> ShowS
showList
instance (Show2 f, Show2 g) => Show2 (Product f g) where
  liftShowsPrec2 :: (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) =
    (Int -> f a b -> ShowS)
-> (Int -> g a b -> ShowS)
-> String
-> Int
-> f a b
-> g a b
-> ShowS
forall a b.
(Int -> a -> ShowS)
-> (Int -> b -> ShowS) -> String -> Int -> a -> b -> ShowS
showsBinaryWith ((Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
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)
                    ((Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> g a b
-> ShowS
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
#endif

instance (Bifunctor f, Bifunctor g) => Bifunctor (Product f g) where
  first :: (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) = f b c -> g b c -> Product f g b c
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 ((a -> b) -> f a c -> f b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first a -> b
f f a c
x) ((a -> b) -> g a c -> g b c
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 :: (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) = f a c -> g a c -> Product f g a c
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 ((b -> c) -> f a b -> f a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second b -> c
g f a b
x) ((b -> c) -> g a b -> g a c
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 :: (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) = f b d -> g b d -> Product f g b d
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 ((a -> b) -> (c -> d) -> f a c -> f b d
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) ((a -> b) -> (c -> d) -> g a c -> g b d
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 :: a -> b -> Product f g a b
bipure a
a b
b = f a b -> g a b -> Product f g 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 (a -> b -> f a b
forall (p :: * -> * -> *) a b. Biapplicative p => a -> b -> p a b
bipure a
a b
b) (a -> b -> g a 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 <<*>> :: 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 = f b d -> g b d -> Product f g b d
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 f (a -> b) (c -> d) -> f a c -> f b d
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 g (a -> b) (c -> d) -> g a c -> g b d
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 :: (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) = (a -> m) -> (b -> m) -> f a b -> m
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 m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (a -> m) -> (b -> m) -> g a b -> m
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 (Bitraversable f, Bitraversable g) => Bitraversable (Product f g) where
  bitraverse :: (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) = f c d -> g c d -> Product f g c d
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 c d -> g c d -> Product f g c d)
-> f (f c d) -> f (g c d -> Product f g c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f c) -> (b -> f d) -> f a b -> f (f c d)
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 f (g c d -> Product f g c d) -> f (g c d) -> f (Product f g c d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f c) -> (b -> f d) -> g a b -> f (g c d)
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 :: (p :-> q) -> Product p p :-> Product p q
bifmap p :-> q
f (Pair p a b
p p a b
q) = p a b -> q a b -> Product p q 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 (p a b -> q a b
p :-> q
f p a b
q)

instance BifunctorComonad (Product p) where
  biextract :: Product p p a b -> p a b
biextract (Pair p a b
_ p a b
q) = p a b
q
  biduplicate :: Product p p a b -> Product p (Product p p) a b
biduplicate pq :: Product p p a b
pq@(Pair p a b
p p a b
_) = p a b -> Product p p a b -> Product p (Product 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 :: (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
_) = p a b -> q a b -> Product p q 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 -> q a b
Product p p :-> q
f Product p p a b
pq)

instance (Category p, Category q) => Category (Product p q) where
  id :: Product p q a a
id = p a a -> q a a -> Product p q a a
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 a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id q a a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
  Pair p b c
x q b c
y . :: Product p q b c -> Product p q a b -> Product p q a c
. Pair p a b
x' q a b
y' = p a c -> q a c -> Product p q a c
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 p b c -> p a b -> p a c
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 q b c -> q a b -> q a c
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 :: (b -> c) -> Product p q b c
arr b -> c
f = p b c -> q b c -> Product p q b c
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 ((b -> c) -> p b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
A.arr b -> c
f) ((b -> c) -> q b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
A.arr b -> c
f)
  first :: Product p q b c -> Product p q (b, d) (c, d)
first (Pair p b c
x q b c
y) = p (b, d) (c, d) -> q (b, d) (c, d) -> Product p q (b, d) (c, d)
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 -> p (b, d) (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first p b c
x) (q b c -> q (b, d) (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first q b c
y)
  second :: Product p q b c -> Product p q (d, b) (d, c)
second (Pair p b c
x q b c
y) = p (d, b) (d, c) -> q (d, b) (d, c) -> Product p q (d, b) (d, c)
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 -> p (d, b) (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
A.second p b c
x) (q b c -> q (d, b) (d, c)
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 *** :: 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' = p (b, b') (c, c')
-> q (b, b') (c, c') -> Product p q (b, b') (c, c')
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 p b c -> p b' c' -> p (b, b') (c, c')
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 q b c -> q b' c' -> q (b, b') (c, c')
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 &&& :: 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' = p b (c, c') -> q b (c, c') -> Product p q b (c, c')
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 p b c -> p b c' -> p b (c, c')
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 q b c -> q b c' -> q b (c, c')
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 :: Product p q b c -> Product p q (Either b d) (Either c d)
left (Pair p b c
x q b c
y) = p (Either b d) (Either c d)
-> q (Either b d) (Either c d)
-> Product p q (Either b d) (Either c d)
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 -> p (Either b d) (Either c d)
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
A.left p b c
x) (q b c -> q (Either b d) (Either c d)
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
A.left q b c
y)
  right :: Product p q b c -> Product p q (Either d b) (Either d c)
right (Pair p b c
x q b c
y) = p (Either d b) (Either d c)
-> q (Either d b) (Either d c)
-> Product p q (Either d b) (Either d c)
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 -> p (Either d b) (Either d c)
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either d b) (Either d c)
A.right p b c
x) (q b c -> q (Either d b) (Either d c)
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 +++ :: 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' = p (Either b b') (Either c c')
-> q (Either b b') (Either c c')
-> Product p q (Either b b') (Either c c')
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 p b c -> p b' c' -> p (Either b b') (Either c c')
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 q b c -> q b' c' -> q (Either b b') (Either c c')
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 ||| :: 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' = p (Either b c) d -> q (Either b c) d -> Product p q (Either b c) d
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 p b d -> p c d -> p (Either b c) d
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 q b d -> q c d -> q (Either b c) d
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 :: 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) = p b c -> q b c -> Product p q b c
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) (c, d) -> p b c
forall (a :: * -> * -> *) b d c.
ArrowLoop a =>
a (b, d) (c, d) -> a b c
A.loop p (b, d) (c, d)
x) (q (b, d) (c, d) -> q b c
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 :: Product p q b c
zeroArrow = p b c -> q b c -> Product p q b c
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
forall (a :: * -> * -> *) b c. ArrowZero a => a b c
A.zeroArrow q b c
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 <+> :: Product p q b c -> Product p q b c -> Product p q b c
<+> Pair p b c
x' q b c
y' = p b c -> q b c -> Product p q b c
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 p b c -> p b c -> p b c
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
A.<+> p b c
x') (q b c
y q b c -> q b c -> q b c
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
A.<+> q b c
y')