{-# OPTIONS_HADDOCK not-home #-}

-- | Classes for co- and contravariant bifunctors.
--
-- This module is intended for internal use only, and may change without warning
-- in subsequent releases.
module Optics.Internal.Bi where

import Data.Coerce
import Data.Void

import Data.Profunctor.Indexed

-- | Class for (covariant) bifunctors.
class Bifunctor p where
  bimap  :: (a -> b) -> (c -> d) -> p i a c -> p i b d
  first  :: (a -> b)             -> p i a c -> p i b c
  second ::             (c -> d) -> p i a c -> p i a d

instance Bifunctor Tagged where
  bimap :: (a -> b) -> (c -> d) -> Tagged i a c -> Tagged i b d
bimap  a -> b
_f c -> d
g = d -> Tagged i b d
forall i a b. b -> Tagged i a b
Tagged (d -> Tagged i b d) -> (c -> d) -> c -> Tagged i b d
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. c -> d
g (c -> Tagged i b d)
-> (Tagged i a c -> c) -> Tagged i a c -> Tagged i b d
forall a b c. Coercible a b => (b -> c) -> (a -> b) -> a -> c
.# Tagged i a c -> c
forall i a b. Tagged i a b -> b
unTagged
  first :: (a -> b) -> Tagged i a c -> Tagged i b c
first  a -> b
_f   = Tagged i a c -> Tagged i b c
coerce
  second :: (c -> d) -> Tagged i a c -> Tagged i a d
second    c -> d
g = d -> Tagged i a d
forall i a b. b -> Tagged i a b
Tagged (d -> Tagged i a d) -> (c -> d) -> c -> Tagged i a d
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. c -> d
g (c -> Tagged i a d)
-> (Tagged i a c -> c) -> Tagged i a c -> Tagged i a d
forall a b c. Coercible a b => (b -> c) -> (a -> b) -> a -> c
.# Tagged i a c -> c
forall i a b. Tagged i a b -> b
unTagged

-- | Class for contravariant bifunctors.
class Bicontravariant p where
  contrabimap  :: (b -> a) -> (d -> c) -> p i a c -> p i b d
  contrafirst  :: (b -> a)             -> p i a c -> p i b c
  contrasecond ::             (c -> b) -> p i a b -> p i a c

instance Bicontravariant (Forget r) where
  contrabimap :: (b -> a) -> (d -> c) -> Forget r i a c -> Forget r i b d
contrabimap  b -> a
f d -> c
_g (Forget a -> r
k) = (b -> r) -> Forget r i b d
forall r i a b. (a -> r) -> Forget r i a b
Forget (a -> r
k (a -> r) -> (b -> a) -> b -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
f)
  contrafirst :: (b -> a) -> Forget r i a c -> Forget r i b c
contrafirst  b -> a
f    (Forget a -> r
k) = (b -> r) -> Forget r i b c
forall r i a b. (a -> r) -> Forget r i a b
Forget (a -> r
k (a -> r) -> (b -> a) -> b -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
f)
  contrasecond :: (c -> b) -> Forget r i a b -> Forget r i a c
contrasecond   c -> b
_g (Forget a -> r
k) = (a -> r) -> Forget r i a c
forall r i a b. (a -> r) -> Forget r i a b
Forget a -> r
k

instance Bicontravariant (ForgetM r) where
  contrabimap :: (b -> a) -> (d -> c) -> ForgetM r i a c -> ForgetM r i b d
contrabimap  b -> a
f d -> c
_g (ForgetM a -> Maybe r
k) = (b -> Maybe r) -> ForgetM r i b d
forall r i a b. (a -> Maybe r) -> ForgetM r i a b
ForgetM (a -> Maybe r
k (a -> Maybe r) -> (b -> a) -> b -> Maybe r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
f)
  contrafirst :: (b -> a) -> ForgetM r i a c -> ForgetM r i b c
contrafirst  b -> a
f    (ForgetM a -> Maybe r
k) = (b -> Maybe r) -> ForgetM r i b c
forall r i a b. (a -> Maybe r) -> ForgetM r i a b
ForgetM (a -> Maybe r
k (a -> Maybe r) -> (b -> a) -> b -> Maybe r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
f)
  contrasecond :: (c -> b) -> ForgetM r i a b -> ForgetM r i a c
contrasecond   c -> b
_g (ForgetM a -> Maybe r
k) = (a -> Maybe r) -> ForgetM r i a c
forall r i a b. (a -> Maybe r) -> ForgetM r i a b
ForgetM a -> Maybe r
k

instance Bicontravariant (IxForget r) where
  contrabimap :: (b -> a) -> (d -> c) -> IxForget r i a c -> IxForget r i b d
contrabimap  b -> a
f d -> c
_g (IxForget i -> a -> r
k) = (i -> b -> r) -> IxForget r i b d
forall r i a b. (i -> a -> r) -> IxForget r i a b
IxForget (\i
i -> i -> a -> r
k i
i (a -> r) -> (b -> a) -> b -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
f)
  contrafirst :: (b -> a) -> IxForget r i a c -> IxForget r i b c
contrafirst  b -> a
f    (IxForget i -> a -> r
k) = (i -> b -> r) -> IxForget r i b c
forall r i a b. (i -> a -> r) -> IxForget r i a b
IxForget (\i
i -> i -> a -> r
k i
i (a -> r) -> (b -> a) -> b -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
f)
  contrasecond :: (c -> b) -> IxForget r i a b -> IxForget r i a c
contrasecond   c -> b
_g (IxForget i -> a -> r
k) = (i -> a -> r) -> IxForget r i a c
forall r i a b. (i -> a -> r) -> IxForget r i a b
IxForget i -> a -> r
k

instance Bicontravariant (IxForgetM r) where
  contrabimap :: (b -> a) -> (d -> c) -> IxForgetM r i a c -> IxForgetM r i b d
contrabimap  b -> a
f d -> c
_g (IxForgetM i -> a -> Maybe r
k) = (i -> b -> Maybe r) -> IxForgetM r i b d
forall r i a b. (i -> a -> Maybe r) -> IxForgetM r i a b
IxForgetM (\i
i -> i -> a -> Maybe r
k i
i (a -> Maybe r) -> (b -> a) -> b -> Maybe r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
f)
  contrafirst :: (b -> a) -> IxForgetM r i a c -> IxForgetM r i b c
contrafirst  b -> a
f    (IxForgetM i -> a -> Maybe r
k) = (i -> b -> Maybe r) -> IxForgetM r i b c
forall r i a b. (i -> a -> Maybe r) -> IxForgetM r i a b
IxForgetM (\i
i -> i -> a -> Maybe r
k i
i (a -> Maybe r) -> (b -> a) -> b -> Maybe r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
f)
  contrasecond :: (c -> b) -> IxForgetM r i a b -> IxForgetM r i a c
contrasecond   c -> b
_g (IxForgetM i -> a -> Maybe r
k) = (i -> a -> Maybe r) -> IxForgetM r i a c
forall r i a b. (i -> a -> Maybe r) -> IxForgetM r i a b
IxForgetM i -> a -> Maybe r
k

----------------------------------------

-- | If @p@ is a 'Profunctor' and a 'Bifunctor' then its left parameter must be
-- phantom.
lphantom :: (Profunctor p, Bifunctor p) => p i a c -> p i b c
lphantom :: p i a c -> p i b c
lphantom = (Void -> b) -> p i Void c -> p i b c
forall (p :: * -> * -> * -> *) a b i c.
Bifunctor p =>
(a -> b) -> p i a c -> p i b c
first Void -> b
forall a. Void -> a
absurd (p i Void c -> p i b c)
-> (p i a c -> p i Void c) -> p i a c -> p i b c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Void -> a) -> p i a c -> p i Void c
forall (p :: * -> * -> * -> *) a b i c.
Profunctor p =>
(a -> b) -> p i b c -> p i a c
lmap Void -> a
forall a. Void -> a
absurd

-- | If @p@ is a 'Profunctor' and 'Bicontravariant' then its right parameter
-- must be phantom.
rphantom :: (Profunctor p, Bicontravariant p) => p i c a -> p i c b
rphantom :: p i c a -> p i c b
rphantom = (Void -> b) -> p i c Void -> p i c b
forall (p :: * -> * -> * -> *) c d i b.
Profunctor p =>
(c -> d) -> p i b c -> p i b d
rmap Void -> b
forall a. Void -> a
absurd (p i c Void -> p i c b)
-> (p i c a -> p i c Void) -> p i c a -> p i c b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Void -> a) -> p i c a -> p i c Void
forall (p :: * -> * -> * -> *) c b i a.
Bicontravariant p =>
(c -> b) -> p i a b -> p i a c
contrasecond Void -> a
forall a. Void -> a
absurd