{-# 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 :: forall a b c d i.
(a -> b) -> (c -> d) -> Tagged i a c -> Tagged i b d
bimap  a -> b
_f c -> d
g = forall i a b. b -> Tagged i a b
Tagged forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. c -> d
g forall a b c. Coercible a b => (b -> c) -> (a -> b) -> a -> c
.# forall i a b. Tagged i a b -> b
unTagged
  first :: forall a b i c. (a -> b) -> Tagged i a c -> Tagged i b c
first  a -> b
_f   = coerce :: forall a b. Coercible a b => a -> b
coerce
  second :: forall c d i a. (c -> d) -> Tagged i a c -> Tagged i a d
second    c -> d
g = forall i a b. b -> Tagged i a b
Tagged forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. c -> d
g forall a b c. Coercible a b => (b -> c) -> (a -> b) -> a -> 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 :: forall b a d c i.
(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) = forall r i a b. (a -> r) -> Forget r i a b
Forget (a -> r
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
f)
  contrafirst :: forall b a i c. (b -> a) -> Forget r i a c -> Forget r i b c
contrafirst  b -> a
f    (Forget a -> r
k) = forall r i a b. (a -> r) -> Forget r i a b
Forget (a -> r
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
f)
  contrasecond :: forall c b i a. (c -> b) -> Forget r i a b -> Forget r i a c
contrasecond   c -> b
_g (Forget a -> r
k) = forall r i a b. (a -> r) -> Forget r i a b
Forget a -> r
k

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

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

instance Bicontravariant (IxForgetM r) where
  contrabimap :: forall b a d c i.
(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) = forall r i a b. (i -> a -> Maybe r) -> IxForgetM r i a b
IxForgetM (\i
i -> i -> a -> Maybe r
k i
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
f)
  contrafirst :: forall b a i c. (b -> a) -> IxForgetM r i a c -> IxForgetM r i b c
contrafirst  b -> a
f    (IxForgetM i -> a -> Maybe r
k) = forall r i a b. (i -> a -> Maybe r) -> IxForgetM r i a b
IxForgetM (\i
i -> i -> a -> Maybe r
k i
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
f)
  contrasecond :: forall c b i a. (c -> b) -> IxForgetM r i a b -> IxForgetM r i a c
contrasecond   c -> b
_g (IxForgetM i -> a -> Maybe r
k) = 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 :: forall (p :: * -> * -> * -> *) i a c b.
(Profunctor p, Bifunctor p) =>
p i a c -> p i b c
lphantom = forall (p :: * -> * -> * -> *) a b i c.
Bifunctor p =>
(a -> b) -> p i a c -> p i b c
first forall a. Void -> a
absurd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> * -> *) a b i c.
Profunctor p =>
(a -> b) -> p i b c -> p i a c
lmap 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 :: forall (p :: * -> * -> * -> *) i c a b.
(Profunctor p, Bicontravariant p) =>
p i c a -> p i c b
rphantom = forall (p :: * -> * -> * -> *) c d i b.
Profunctor p =>
(c -> d) -> p i b c -> p i b d
rmap forall a. Void -> a
absurd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> * -> *) c b i a.
Bicontravariant p =>
(c -> b) -> p i a b -> p i a c
contrasecond forall a. Void -> a
absurd