-- |
-- Module: Optics.Re
-- Description: The 're' operator allows some optics to be reversed.
--
-- Some optics can be reversed with 're'.  This is mainly useful to invert
-- 'Optics.Iso.Iso's:
--
-- >>> let _Identity = iso runIdentity Identity
-- >>> view (_1 % re _Identity) ('x', "yz")
-- Identity 'x'
--
-- Yet we can use a 'Optics.Lens.Lens' as a 'Optics.Review.Review' too:
--
-- >>> review (re _1) ('x', "yz")
-- 'x'
--
-- In the following diagram, red arrows illustrate how 're' transforms optics.
-- The 'Optics.ReversedLens.ReversedLens' and
-- 'Optics.ReversedPrism.ReversedPrism' optic kinds are backwards versions of
-- 'Optics.Lens.Lens' and 'Optics.Prism.Prism' respectively, and are present so
-- that @'re' . 're'@ does not change the optic kind.
--
-- <<diagrams/reoptics.png Reversed Optics>>
--
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilyDependencies #-}
module Optics.Re
  ( ReversibleOptic(..)
  ) where

import Data.Coerce

import Data.Profunctor.Indexed

import Optics.Internal.Bi
import Optics.Internal.Indexed
import Optics.Internal.Optic

-- | Class for optics that can be 're'versed.
class ReversibleOptic k where
  -- | Injective type family that maps an optic kind to the optic kind produced
  -- by 're'versing it.
  --
  -- @
  -- 'ReversedOptic' 'An_Iso'            = 'An_Iso'
  -- 'ReversedOptic' 'A_Prism'           = 'A_ReversedPrism'
  -- 'ReversedOptic' 'A_ReversedPrism'   = 'A_Prism'
  -- 'ReversedOptic' 'A_Lens'            = 'A_ReversedLens'
  -- 'ReversedOptic' 'A_ReversedLens'    = 'A_Lens'
  -- 'ReversedOptic' 'A_Getter'          = 'A_Review'
  -- 'ReversedOptic' 'A_Review'          = 'A_Getter'
  -- @
  type ReversedOptic k = r | r -> k
  -- | Reverses optics, turning around 'Optics.Iso.Iso' into 'Optics.Iso.Iso',
  -- 'Optics.Prism.Prism' into 'Optics.ReversedPrism.ReversedPrism' (and
  -- back), 'Optics.Lens.Lens' into 'Optics.ReversedLens.ReversedLens' (and back)
  -- and 'Optics.Getter.Getter' into 'Optics.Review.Review' (and back).
  re
    :: "re" `AcceptsEmptyIndices` is
    => Optic                k  is s t a b
    -> Optic (ReversedOptic k) is b a t s

instance ReversibleOptic An_Iso where
  type ReversedOptic An_Iso = An_Iso
  re :: forall (is :: IxList) s t a b.
AcceptsEmptyIndices "re" is =>
Optic An_Iso is s t a b -> Optic (ReversedOptic An_Iso) is b a t s
re Optic An_Iso is s t a b
o = forall k (is :: IxList) s t a b.
(forall (p :: * -> * -> * -> *) i.
 Profunctor p =>
 Optic_ k p i (Curry is i) s t a b)
-> Optic k is s t a b
Optic (forall (p :: * -> * -> * -> *) k a b s t i.
(Profunctor p, Constraints k (Re p a b)) =>
Optic k NoIx s t a b -> Optic__ p i i b a t s
re__ Optic An_Iso is s t a b
o)
  {-# INLINE re #-}

instance ReversibleOptic A_Prism where
  type ReversedOptic A_Prism = A_ReversedPrism
  re :: forall (is :: IxList) s t a b.
AcceptsEmptyIndices "re" is =>
Optic A_Prism is s t a b
-> Optic (ReversedOptic A_Prism) is b a t s
re Optic A_Prism is s t a b
o = forall k (is :: IxList) s t a b.
(forall (p :: * -> * -> * -> *) i.
 Profunctor p =>
 Optic_ k p i (Curry is i) s t a b)
-> Optic k is s t a b
Optic (forall (p :: * -> * -> * -> *) k a b s t i.
(Profunctor p, Constraints k (Re p a b)) =>
Optic k NoIx s t a b -> Optic__ p i i b a t s
re__ Optic A_Prism is s t a b
o)
  {-# INLINE re #-}

instance ReversibleOptic A_ReversedPrism where
  type ReversedOptic A_ReversedPrism = A_Prism
  re :: forall (is :: IxList) s t a b.
AcceptsEmptyIndices "re" is =>
Optic A_ReversedPrism is s t a b
-> Optic (ReversedOptic A_ReversedPrism) is b a t s
re Optic A_ReversedPrism is s t a b
o = forall k (is :: IxList) s t a b.
(forall (p :: * -> * -> * -> *) i.
 Profunctor p =>
 Optic_ k p i (Curry is i) s t a b)
-> Optic k is s t a b
Optic (forall (p :: * -> * -> * -> *) k a b s t i.
(Profunctor p, Constraints k (Re p a b)) =>
Optic k NoIx s t a b -> Optic__ p i i b a t s
re__ Optic A_ReversedPrism is s t a b
o)
  {-# INLINE re #-}

instance ReversibleOptic A_Lens where
  type ReversedOptic A_Lens = A_ReversedLens
  re :: forall (is :: IxList) s t a b.
AcceptsEmptyIndices "re" is =>
Optic A_Lens is s t a b -> Optic (ReversedOptic A_Lens) is b a t s
re Optic A_Lens is s t a b
o = forall k (is :: IxList) s t a b.
(forall (p :: * -> * -> * -> *) i.
 Profunctor p =>
 Optic_ k p i (Curry is i) s t a b)
-> Optic k is s t a b
Optic (forall (p :: * -> * -> * -> *) k a b s t i.
(Profunctor p, Constraints k (Re p a b)) =>
Optic k NoIx s t a b -> Optic__ p i i b a t s
re__ Optic A_Lens is s t a b
o)
  {-# INLINE re #-}

instance ReversibleOptic A_ReversedLens where
  type ReversedOptic A_ReversedLens = A_Lens
  re :: forall (is :: IxList) s t a b.
AcceptsEmptyIndices "re" is =>
Optic A_ReversedLens is s t a b
-> Optic (ReversedOptic A_ReversedLens) is b a t s
re Optic A_ReversedLens is s t a b
o = forall k (is :: IxList) s t a b.
(forall (p :: * -> * -> * -> *) i.
 Profunctor p =>
 Optic_ k p i (Curry is i) s t a b)
-> Optic k is s t a b
Optic (forall (p :: * -> * -> * -> *) k a b s t i.
(Profunctor p, Constraints k (Re p a b)) =>
Optic k NoIx s t a b -> Optic__ p i i b a t s
re__ Optic A_ReversedLens is s t a b
o)
  {-# INLINE re #-}

instance ReversibleOptic A_Getter where
  type ReversedOptic A_Getter = A_Review
  re :: forall (is :: IxList) s t a b.
AcceptsEmptyIndices "re" is =>
Optic A_Getter is s t a b
-> Optic (ReversedOptic A_Getter) is b a t s
re Optic A_Getter is s t a b
o = forall k (is :: IxList) s t a b.
(forall (p :: * -> * -> * -> *) i.
 Profunctor p =>
 Optic_ k p i (Curry is i) s t a b)
-> Optic k is s t a b
Optic (forall (p :: * -> * -> * -> *) k a b s t i.
(Profunctor p, Constraints k (Re p a b)) =>
Optic k NoIx s t a b -> Optic__ p i i b a t s
re__ Optic A_Getter is s t a b
o)
  {-# INLINE re #-}

instance ReversibleOptic A_Review where
  type ReversedOptic A_Review = A_Getter
  re :: forall (is :: IxList) s t a b.
AcceptsEmptyIndices "re" is =>
Optic A_Review is s t a b
-> Optic (ReversedOptic A_Review) is b a t s
re Optic A_Review is s t a b
o = forall k (is :: IxList) s t a b.
(forall (p :: * -> * -> * -> *) i.
 Profunctor p =>
 Optic_ k p i (Curry is i) s t a b)
-> Optic k is s t a b
Optic (forall (p :: * -> * -> * -> *) k a b s t i.
(Profunctor p, Constraints k (Re p a b)) =>
Optic k NoIx s t a b -> Optic__ p i i b a t s
re__ Optic A_Review is s t a b
o)
  {-# INLINE re #-}

-- | Internal implementation of re.
re__
  :: (Profunctor p, Constraints k (Re p a b))
  => Optic k  NoIx s t a b
  -> Optic__ p i i b a t s
re__ :: forall (p :: * -> * -> * -> *) k a b s t i.
(Profunctor p, Constraints k (Re p a b)) =>
Optic k NoIx s t a b -> Optic__ p i i b a t s
re__ Optic k NoIx s t a b
o = forall (p :: * -> * -> * -> *) s t i a b.
Re p s t i a b -> p i b a -> p i t s
unRe (forall (p :: * -> * -> * -> *) k (is :: IxList) s t a b i.
Profunctor p =>
Optic k is s t a b -> Optic_ k p i (Curry is i) s t a b
getOptic Optic k NoIx s t a b
o (forall (p :: * -> * -> * -> *) s t i a b.
(p i b a -> p i t s) -> Re p s t i a b
Re forall a. a -> a
id))
{-# INLINE re__ #-}

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

-- | Helper for reversing optics.
newtype Re p s t i a b = Re { forall (p :: * -> * -> * -> *) s t i a b.
Re p s t i a b -> p i b a -> p i t s
unRe :: p i b a -> p i t s }

instance Profunctor p => Profunctor (Re p s t) where
  dimap :: forall a b c d i.
(a -> b) -> (c -> d) -> Re p s t i b c -> Re p s t i a d
dimap a -> b
f c -> d
g (Re p i c b -> p i t s
p) = forall (p :: * -> * -> * -> *) s t i a b.
(p i b a -> p i t s) -> Re p s t i a b
Re (p i c b -> p i t s
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> * -> *) a b c d i.
Profunctor p =>
(a -> b) -> (c -> d) -> p i b c -> p i a d
dimap c -> d
g a -> b
f)
  lmap :: forall a b i c. (a -> b) -> Re p s t i b c -> Re p s t i a c
lmap  a -> b
f   (Re p i c b -> p i t s
p) = forall (p :: * -> * -> * -> *) s t i a b.
(p i b a -> p i t s) -> Re p s t i a b
Re (p i c b -> p i t s
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> * -> *) c d i b.
Profunctor p =>
(c -> d) -> p i b c -> p i b d
rmap a -> b
f)
  rmap :: forall c d i b. (c -> d) -> Re p s t i b c -> Re p s t i b d
rmap    c -> d
g (Re p i c b -> p i t s
p) = forall (p :: * -> * -> * -> *) s t i a b.
(p i b a -> p i t s) -> Re p s t i a b
Re (p i c b -> p i t s
p 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 c -> d
g)
  {-# INLINE dimap #-}
  {-# INLINE lmap #-}
  {-# INLINE rmap #-}

  lcoerce' :: forall a b i c. Coercible a b => Re p s t i a c -> Re p s t i b c
lcoerce' = forall (p :: * -> * -> * -> *) a b i c.
Profunctor p =>
(a -> b) -> p i b c -> p i a c
lmap coerce :: forall a b. Coercible a b => a -> b
coerce
  rcoerce' :: forall a b i c. Coercible a b => Re p s t i c a -> Re p s t i c b
rcoerce' = forall (p :: * -> * -> * -> *) c d i b.
Profunctor p =>
(c -> d) -> p i b c -> p i b d
rmap coerce :: forall a b. Coercible a b => a -> b
coerce
  {-# INLINE lcoerce' #-}
  {-# INLINE rcoerce' #-}

  conjoined__ :: forall i a b s t j.
(Re p s t i a b -> Re p s t i s t)
-> (Re p s t i a b -> Re p s t j s t)
-> Re p s t i a b
-> Re p s t j s t
conjoined__ = forall a. HasCallStack => [Char] -> a
error [Char]
"conjoined__(Re) shouldn't be reachable"
  ixcontramap :: forall j i a b. (j -> i) -> Re p s t i a b -> Re p s t j a b
ixcontramap = forall a. HasCallStack => [Char] -> a
error [Char]
"ixcontramap(Re) shouldn't be reachable"

instance Bicontravariant p => Bifunctor (Re p s t) where
  bimap :: forall a b c d i.
(a -> b) -> (c -> d) -> Re p s t i a c -> Re p s t i b d
bimap  a -> b
f c -> d
g (Re p i c a -> p i t s
p) = forall (p :: * -> * -> * -> *) s t i a b.
(p i b a -> p i t s) -> Re p s t i a b
Re (p i c a -> p i t s
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> * -> *) b a d c i.
Bicontravariant p =>
(b -> a) -> (d -> c) -> p i a c -> p i b d
contrabimap c -> d
g a -> b
f)
  first :: forall a b i c. (a -> b) -> Re p s t i a c -> Re p s t i b c
first  a -> b
f   (Re p i c a -> p i t s
p) = forall (p :: * -> * -> * -> *) s t i a b.
(p i b a -> p i t s) -> Re p s t i a b
Re (p i c a -> p i t s
p 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 a -> b
f)
  second :: forall c d i a. (c -> d) -> Re p s t i a c -> Re p s t i a d
second   c -> d
g (Re p i c a -> p i t s
p) = forall (p :: * -> * -> * -> *) s t i a b.
(p i b a -> p i t s) -> Re p s t i a b
Re (p i c a -> p i t s
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> * -> *) b a i c.
Bicontravariant p =>
(b -> a) -> p i a c -> p i b c
contrafirst c -> d
g)
  {-# INLINE bimap #-}
  {-# INLINE first #-}
  {-# INLINE second #-}

instance Bifunctor p => Bicontravariant (Re p s t) where
  contrabimap :: forall b a d c i.
(b -> a) -> (d -> c) -> Re p s t i a c -> Re p s t i b d
contrabimap  b -> a
f d -> c
g (Re p i c a -> p i t s
p) = forall (p :: * -> * -> * -> *) s t i a b.
(p i b a -> p i t s) -> Re p s t i a b
Re (p i c a -> p i t s
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> * -> *) a b c d i.
Bifunctor p =>
(a -> b) -> (c -> d) -> p i a c -> p i b d
bimap d -> c
g b -> a
f)
  contrafirst :: forall b a i c. (b -> a) -> Re p s t i a c -> Re p s t i b c
contrafirst  b -> a
f   (Re p i c a -> p i t s
p) = forall (p :: * -> * -> * -> *) s t i a b.
(p i b a -> p i t s) -> Re p s t i a b
Re (p i c a -> p i t s
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> * -> *) c d i a.
Bifunctor p =>
(c -> d) -> p i a c -> p i a d
second b -> a
f)
  contrasecond :: forall c b i a. (c -> b) -> Re p s t i a b -> Re p s t i a c
contrasecond   c -> b
g (Re p i b a -> p i t s
p) = forall (p :: * -> * -> * -> *) s t i a b.
(p i b a -> p i t s) -> Re p s t i a b
Re (p i b a -> p i t s
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> * -> *) a b i c.
Bifunctor p =>
(a -> b) -> p i a c -> p i b c
first c -> b
g)
  {-# INLINE contrabimap #-}
  {-# INLINE contrafirst #-}
  {-# INLINE contrasecond #-}

instance Strong p => Costrong (Re p s t) where
  unfirst :: forall i a d b. Re p s t i (a, d) (b, d) -> Re p s t i a b
unfirst  (Re p i (b, d) (a, d) -> p i t s
p) = forall (p :: * -> * -> * -> *) s t i a b.
(p i b a -> p i t s) -> Re p s t i a b
Re (p i (b, d) (a, d) -> p i t s
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> * -> *) i a b c.
Strong p =>
p i a b -> p i (a, c) (b, c)
first')
  unsecond :: forall i d a b. Re p s t i (d, a) (d, b) -> Re p s t i a b
unsecond (Re p i (d, b) (d, a) -> p i t s
p) = forall (p :: * -> * -> * -> *) s t i a b.
(p i b a -> p i t s) -> Re p s t i a b
Re (p i (d, b) (d, a) -> p i t s
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> * -> *) i a b c.
Strong p =>
p i a b -> p i (c, a) (c, b)
second')
  {-# INLINE unfirst #-}
  {-# INLINE unsecond #-}

instance Costrong p => Strong (Re p s t) where
  first' :: forall i a b c. Re p s t i a b -> Re p s t i (a, c) (b, c)
first'  (Re p i b a -> p i t s
p) = forall (p :: * -> * -> * -> *) s t i a b.
(p i b a -> p i t s) -> Re p s t i a b
Re (p i b a -> p i t s
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> * -> *) i a d b.
Costrong p =>
p i (a, d) (b, d) -> p i a b
unfirst)
  second' :: forall i a b c. Re p s t i a b -> Re p s t i (c, a) (c, b)
second' (Re p i b a -> p i t s
p) = forall (p :: * -> * -> * -> *) s t i a b.
(p i b a -> p i t s) -> Re p s t i a b
Re (p i b a -> p i t s
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> * -> *) i d a b.
Costrong p =>
p i (d, a) (d, b) -> p i a b
unsecond)
  {-# INLINE first' #-}
  {-# INLINE second' #-}

  ilinear :: forall i a b s t j.
(forall (f :: * -> *). Functor f => (i -> a -> f b) -> s -> f t)
-> Re p s t j a b -> Re p s t (i -> j) s t
ilinear forall (f :: * -> *). Functor f => (i -> a -> f b) -> s -> f t
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"ilinear(Re) shouldn't be reachable"

instance Choice p => Cochoice (Re p s t) where
  unleft :: forall i a d b.
Re p s t i (Either a d) (Either b d) -> Re p s t i a b
unleft  (Re p i (Either b d) (Either a d) -> p i t s
p) = forall (p :: * -> * -> * -> *) s t i a b.
(p i b a -> p i t s) -> Re p s t i a b
Re (p i (Either b d) (Either a d) -> p i t s
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> * -> *) i a b c.
Choice p =>
p i a b -> p i (Either a c) (Either b c)
left')
  unright :: forall i d a b.
Re p s t i (Either d a) (Either d b) -> Re p s t i a b
unright (Re p i (Either d b) (Either d a) -> p i t s
p) = forall (p :: * -> * -> * -> *) s t i a b.
(p i b a -> p i t s) -> Re p s t i a b
Re (p i (Either d b) (Either d a) -> p i t s
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> * -> *) i a b c.
Choice p =>
p i a b -> p i (Either c a) (Either c b)
right')
  {-# INLINE unleft #-}
  {-# INLINE unright #-}

instance Cochoice p => Choice (Re p s t) where
  left' :: forall i a b c.
Re p s t i a b -> Re p s t i (Either a c) (Either b c)
left'  (Re p i b a -> p i t s
p) = forall (p :: * -> * -> * -> *) s t i a b.
(p i b a -> p i t s) -> Re p s t i a b
Re (p i b a -> p i t s
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> * -> *) i a d b.
Cochoice p =>
p i (Either a d) (Either b d) -> p i a b
unleft)
  right' :: forall i a b c.
Re p s t i a b -> Re p s t i (Either c a) (Either c b)
right' (Re p i b a -> p i t s
p) = forall (p :: * -> * -> * -> *) s t i a b.
(p i b a -> p i t s) -> Re p s t i a b
Re (p i b a -> p i t s
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> * -> *) i d a b.
Cochoice p =>
p i (Either d a) (Either d b) -> p i a b
unright)
  {-# INLINE left' #-}
  {-# INLINE right' #-}

-- $setup
-- >>> import Data.Functor.Identity
-- >>> import Optics.Core