{-# LANGUAGE Safe #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Protolude.Bifunctor
  ( Bifunctor,
    bimap,
    first,
    second,
  )
where

import Control.Applicative (Const (Const))
import Data.Either (Either (Left, Right))
import Data.Function ((.), id)

class Bifunctor p where
  {-# MINIMAL bimap | first, second #-}

  bimap :: (a -> b) -> (c -> d) -> p a c -> p b d
  bimap a -> b
f c -> d
g = (a -> b) -> p a d -> p b d
forall a b c. (a -> b) -> p a c -> p b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first a -> b
f (p a d -> p b d) -> (p a c -> p a d) -> p a c -> p b d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c -> d) -> p a c -> p a d
forall b c a. (b -> c) -> p a b -> p a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second c -> d
g

  first :: (a -> b) -> p a c -> p b c
  first a -> b
f = (a -> b) -> (c -> c) -> p a c -> p b c
forall a b c d. (a -> b) -> (c -> d) -> p a c -> p 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 -> c
forall a. a -> a
id

  second :: (b -> c) -> p a b -> p a c
  second = (a -> a) -> (b -> c) -> p a b -> p a c
forall a b c d. (a -> b) -> (c -> d) -> p a c -> p b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> a
forall a. a -> a
id

instance Bifunctor (,) where
  bimap :: forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
bimap a -> b
f c -> d
g ~(a
a, c
b) = (a -> b
f a
a, c -> d
g c
b)

instance Bifunctor ((,,) x1) where
  bimap :: forall a b c d. (a -> b) -> (c -> d) -> (x1, a, c) -> (x1, b, d)
bimap a -> b
f c -> d
g ~(x1
x1, a
a, c
b) = (x1
x1, a -> b
f a
a, c -> d
g c
b)

instance Bifunctor ((,,,) x1 x2) where
  bimap :: forall a b c d.
(a -> b) -> (c -> d) -> (x1, x2, a, c) -> (x1, x2, b, d)
bimap a -> b
f c -> d
g ~(x1
x1, x2
x2, a
a, c
b) = (x1
x1, x2
x2, a -> b
f a
a, c -> d
g c
b)

instance Bifunctor ((,,,,) x1 x2 x3) where
  bimap :: forall a b c d.
(a -> b) -> (c -> d) -> (x1, x2, x3, a, c) -> (x1, x2, x3, b, d)
bimap a -> b
f c -> d
g ~(x1
x1, x2
x2, x3
x3, a
a, c
b) = (x1
x1, x2
x2, x3
x3, a -> b
f a
a, c -> d
g c
b)

instance Bifunctor ((,,,,,) x1 x2 x3 x4) where
  bimap :: forall a b c d.
(a -> b)
-> (c -> d) -> (x1, x2, x3, x4, a, c) -> (x1, x2, x3, x4, b, d)
bimap a -> b
f c -> d
g ~(x1
x1, x2
x2, x3
x3, x4
x4, a
a, c
b) = (x1
x1, x2
x2, x3
x3, x4
x4, a -> b
f a
a, c -> d
g c
b)

instance Bifunctor ((,,,,,,) x1 x2 x3 x4 x5) where
  bimap :: forall a b c d.
(a -> b)
-> (c -> d)
-> (x1, x2, x3, x4, x5, a, c)
-> (x1, x2, x3, x4, x5, b, d)
bimap a -> b
f c -> d
g ~(x1
x1, x2
x2, x3
x3, x4
x4, x5
x5, a
a, c
b) = (x1
x1, x2
x2, x3
x3, x4
x4, x5
x5, a -> b
f a
a, c -> d
g c
b)

instance Bifunctor Either where
  bimap :: forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
bimap a -> b
f c -> d
_ (Left a
a) = b -> Either b d
forall a b. a -> Either a b
Left (a -> b
f a
a)
  bimap a -> b
_ c -> d
g (Right c
b) = d -> Either b d
forall a b. b -> Either a b
Right (c -> d
g c
b)

instance Bifunctor Const where
  bimap :: forall a b c d. (a -> b) -> (c -> d) -> Const a c -> Const b d
bimap a -> b
f c -> d
_ (Const a
a) = b -> Const b d
forall {k} a (b :: k). a -> Const a b
Const (a -> b
f a
a)