{-# 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 ReversibleOptic k where
type ReversedOptic k = r | r -> k
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 :: 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 (p :: * -> * -> * -> *) i.
Profunctor p =>
Optic_ An_Iso p i (Curry is i) b a t s)
-> Optic An_Iso is b a t s
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 (Optic An_Iso NoIx s t a b -> Optic__ p i i b a t s
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
Optic An_Iso NoIx s t a b
o)
{-# INLINE re #-}
instance ReversibleOptic A_Prism where
type ReversedOptic A_Prism = A_ReversedPrism
re :: 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 (p :: * -> * -> * -> *) i.
Profunctor p =>
Optic_ A_ReversedPrism p i (Curry is i) b a t s)
-> Optic A_ReversedPrism is b a t s
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 (Optic A_Prism NoIx s t a b -> Optic__ p i i b a t s
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
Optic A_Prism NoIx s t a b
o)
{-# INLINE re #-}
instance ReversibleOptic A_ReversedPrism where
type ReversedOptic A_ReversedPrism = A_Prism
re :: 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 (p :: * -> * -> * -> *) i.
Profunctor p =>
Optic_ A_Prism p i (Curry is i) b a t s)
-> Optic A_Prism is b a t s
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 (Optic A_ReversedPrism NoIx s t a b -> Optic__ p i i b a t s
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
Optic A_ReversedPrism NoIx s t a b
o)
{-# INLINE re #-}
instance ReversibleOptic A_Lens where
type ReversedOptic A_Lens = A_ReversedLens
re :: 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 (p :: * -> * -> * -> *) i.
Profunctor p =>
Optic_ A_ReversedLens p i (Curry is i) b a t s)
-> Optic A_ReversedLens is b a t s
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 (Optic A_Lens NoIx s t a b -> Optic__ p i i b a t s
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
Optic A_Lens NoIx s t a b
o)
{-# INLINE re #-}
instance ReversibleOptic A_ReversedLens where
type ReversedOptic A_ReversedLens = A_Lens
re :: 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 (p :: * -> * -> * -> *) i.
Profunctor p =>
Optic_ A_Lens p i (Curry is i) b a t s)
-> Optic A_Lens is b a t s
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 (Optic A_ReversedLens NoIx s t a b -> Optic__ p i i b a t s
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
Optic A_ReversedLens NoIx s t a b
o)
{-# INLINE re #-}
instance ReversibleOptic A_Getter where
type ReversedOptic A_Getter = A_Review
re :: 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 (p :: * -> * -> * -> *) i.
Profunctor p =>
Optic_ A_Review p i (Curry is i) b a t s)
-> Optic A_Review is b a t s
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 (Optic A_Getter NoIx s t a b -> Optic__ p i i b a t s
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
Optic A_Getter NoIx s t a b
o)
{-# INLINE re #-}
instance ReversibleOptic A_Review where
type ReversedOptic A_Review = A_Getter
re :: 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 (p :: * -> * -> * -> *) i.
Profunctor p =>
Optic_ A_Getter p i (Curry is i) b a t s)
-> Optic A_Getter is b a t s
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 (Optic A_Review NoIx s t a b -> Optic__ p i i b a t s
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
Optic A_Review NoIx s t a b
o)
{-# INLINE 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__ :: Optic k NoIx s t a b -> Optic__ p i i b a t s
re__ Optic k NoIx s t a b
o = Re p a b i s t -> Optic__ p i i b a t s
forall (p :: * -> * -> * -> *) s t i a b.
Re p s t i a b -> p i b a -> p i t s
unRe (Optic k NoIx s t a b -> Optic__ (Re p a b) i (Curry NoIx i) s t a b
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 ((p i b a -> p i b a) -> Re p a b i a b
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 b a
forall a. a -> a
id))
{-# INLINE re__ #-}
newtype Re p s t i a b = Re { 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 :: (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) = (p i d a -> p i t s) -> Re p s t i a d
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 (p i c b -> p i t s) -> (p i d a -> p i c b) -> p i d a -> p i t s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c -> d) -> (a -> b) -> p i d a -> p i c b
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 :: (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) = (p i c a -> p i t s) -> Re p s t i a c
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 (p i c b -> p i t s) -> (p i c a -> p i c b) -> p i c a -> p i t s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> p i c a -> p i c b
forall (p :: * -> * -> * -> *) c d i b.
Profunctor p =>
(c -> d) -> p i b c -> p i b d
rmap a -> b
f)
rmap :: (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) = (p i d b -> p i t s) -> Re p s t i b d
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 (p i c b -> p i t s) -> (p i d b -> p i c b) -> p i d b -> p i t s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c -> d) -> p i d b -> p i c b
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' :: Re p s t i a c -> Re p s t i b c
lcoerce' = (b -> a) -> Re p s t i a c -> Re p s t i b c
forall (p :: * -> * -> * -> *) a b i c.
Profunctor p =>
(a -> b) -> p i b c -> p i a c
lmap b -> a
coerce
rcoerce' :: Re p s t i c a -> Re p s t i c b
rcoerce' = (a -> b) -> Re p s t i c a -> Re p s t i c b
forall (p :: * -> * -> * -> *) c d i b.
Profunctor p =>
(c -> d) -> p i b c -> p i b d
rmap a -> b
coerce
{-# INLINE lcoerce' #-}
{-# INLINE rcoerce' #-}
conjoined__ :: (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__ = [Char]
-> (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
forall a. HasCallStack => [Char] -> a
error [Char]
"conjoined__(Re) shouldn't be reachable"
ixcontramap :: (j -> i) -> Re p s t i a b -> Re p s t j a b
ixcontramap = [Char] -> (j -> i) -> Re p s t i a b -> Re p s t j a b
forall a. HasCallStack => [Char] -> a
error [Char]
"ixcontramap(Re) shouldn't be reachable"
instance Bicontravariant p => Bifunctor (Re p s t) where
bimap :: (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) = (p i d b -> p i t s) -> Re p s t i b d
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 (p i c a -> p i t s) -> (p i d b -> p i c a) -> p i d b -> p i t s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c -> d) -> (a -> b) -> p i d b -> p i c a
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 :: (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) = (p i c b -> p i t s) -> Re p s t i b c
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 (p i c a -> p i t s) -> (p i c b -> p i c a) -> p i c b -> p i t s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> p i c b -> p i c a
forall (p :: * -> * -> * -> *) c b i a.
Bicontravariant p =>
(c -> b) -> p i a b -> p i a c
contrasecond a -> b
f)
second :: (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) = (p i d a -> p i t s) -> Re p s t i a d
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 (p i c a -> p i t s) -> (p i d a -> p i c a) -> p i d a -> p i t s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c -> d) -> p i d a -> p i c a
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 :: (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) = (p i d b -> p i t s) -> Re p s t i b d
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 (p i c a -> p i t s) -> (p i d b -> p i c a) -> p i d b -> p i t s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (d -> c) -> (b -> a) -> p i d b -> p i c a
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 :: (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) = (p i c b -> p i t s) -> Re p s t i b c
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 (p i c a -> p i t s) -> (p i c b -> p i c a) -> p i c b -> p i t s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> a) -> p i c b -> p i c a
forall (p :: * -> * -> * -> *) c d i a.
Bifunctor p =>
(c -> d) -> p i a c -> p i a d
second b -> a
f)
contrasecond :: (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) = (p i c a -> p i t s) -> Re p s t i a c
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 (p i b a -> p i t s) -> (p i c a -> p i b a) -> p i c a -> p i t s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c -> b) -> p i c a -> p i b a
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 :: 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) = (p i b a -> p i t s) -> Re p s t i a b
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 (p i (b, d) (a, d) -> p i t s)
-> (p i b a -> p i (b, d) (a, d)) -> p i b a -> p i t s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p i b a -> p i (b, d) (a, d)
forall (p :: * -> * -> * -> *) i a b c.
Strong p =>
p i a b -> p i (a, c) (b, c)
first')
unsecond :: 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) = (p i b a -> p i t s) -> Re p s t i a b
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 (p i (d, b) (d, a) -> p i t s)
-> (p i b a -> p i (d, b) (d, a)) -> p i b a -> p i t s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p i b a -> p i (d, b) (d, a)
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' :: 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) = (p i (b, c) (a, c) -> p i t s) -> Re p s t i (a, c) (b, c)
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 (p i b a -> p i t s)
-> (p i (b, c) (a, c) -> p i b a) -> p i (b, c) (a, c) -> p i t s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p i (b, c) (a, c) -> p i b a
forall (p :: * -> * -> * -> *) i a d b.
Costrong p =>
p i (a, d) (b, d) -> p i a b
unfirst)
second' :: 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) = (p i (c, b) (c, a) -> p i t s) -> Re p s t i (c, a) (c, b)
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 (p i b a -> p i t s)
-> (p i (c, b) (c, a) -> p i b a) -> p i (c, b) (c, a) -> p i t s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p i (c, b) (c, a) -> p i b a
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 (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
_ = [Char] -> Re p s t j a b -> Re p s t (i -> j) s t
forall a. HasCallStack => [Char] -> a
error [Char]
"ilinear(Re) shouldn't be reachable"
instance Choice p => Cochoice (Re p s t) where
unleft :: 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) = (p i b a -> p i t s) -> Re p s t i a b
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 (p i (Either b d) (Either a d) -> p i t s)
-> (p i b a -> p i (Either b d) (Either a d)) -> p i b a -> p i t s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p i b a -> p i (Either b d) (Either a d)
forall (p :: * -> * -> * -> *) i a b c.
Choice p =>
p i a b -> p i (Either a c) (Either b c)
left')
unright :: 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) = (p i b a -> p i t s) -> Re p s t i a b
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 (p i (Either d b) (Either d a) -> p i t s)
-> (p i b a -> p i (Either d b) (Either d a)) -> p i b a -> p i t s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p i b a -> p i (Either d b) (Either d a)
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' :: 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) = (p i (Either b c) (Either a c) -> p i t s)
-> Re p s t i (Either a c) (Either b c)
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 (p i b a -> p i t s)
-> (p i (Either b c) (Either a c) -> p i b a)
-> p i (Either b c) (Either a c)
-> p i t s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p i (Either b c) (Either a c) -> p i b a
forall (p :: * -> * -> * -> *) i a d b.
Cochoice p =>
p i (Either a d) (Either b d) -> p i a b
unleft)
right' :: 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) = (p i (Either c b) (Either c a) -> p i t s)
-> Re p s t i (Either c a) (Either c b)
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 (p i b a -> p i t s)
-> (p i (Either c b) (Either c a) -> p i b a)
-> p i (Either c b) (Either c a)
-> p i t s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p i (Either c b) (Either c a) -> p i b a
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' #-}