-- |
-- 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 o = Optic (re__ o)
{-# INLINE re #-}
instance ReversibleOptic A_Prism where
type ReversedOptic A_Prism = A_ReversedPrism
re o = Optic (re__ o)
{-# INLINE re #-}
instance ReversibleOptic A_ReversedPrism where
type ReversedOptic A_ReversedPrism = A_Prism
re o = Optic (re__ o)
{-# INLINE re #-}
instance ReversibleOptic A_Lens where
type ReversedOptic A_Lens = A_ReversedLens
re o = Optic (re__ o)
{-# INLINE re #-}
instance ReversibleOptic A_ReversedLens where
type ReversedOptic A_ReversedLens = A_Lens
re o = Optic (re__ o)
{-# INLINE re #-}
instance ReversibleOptic A_Getter where
type ReversedOptic A_Getter = A_Review
re o = Optic (re__ o)
{-# INLINE re #-}
instance ReversibleOptic A_Review where
type ReversedOptic A_Review = A_Getter
re o = Optic (re__ 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__ o = unRe (getOptic o (Re id))
{-# INLINE re__ #-}
----------------------------------------
-- | Helper for reversing optics.
newtype Re p s t i a b = Re { unRe :: p i b a -> p i t s }
instance Profunctor p => Profunctor (Re p s t) where
dimap f g (Re p) = Re (p . dimap g f)
lmap f (Re p) = Re (p . rmap f)
rmap g (Re p) = Re (p . lmap g)
{-# INLINE dimap #-}
{-# INLINE lmap #-}
{-# INLINE rmap #-}
lcoerce' = lmap coerce
rcoerce' = rmap coerce
{-# INLINE lcoerce' #-}
{-# INLINE rcoerce' #-}
conjoined__ = error "conjoined__(Re) shouldn't be reachable"
ixcontramap = error "ixcontramap(Re) shouldn't be reachable"
instance Bicontravariant p => Bifunctor (Re p s t) where
bimap f g (Re p) = Re (p . contrabimap g f)
first f (Re p) = Re (p . contrasecond f)
second g (Re p) = Re (p . contrafirst g)
{-# INLINE bimap #-}
{-# INLINE first #-}
{-# INLINE second #-}
instance Bifunctor p => Bicontravariant (Re p s t) where
contrabimap f g (Re p) = Re (p . bimap g f)
contrafirst f (Re p) = Re (p . second f)
contrasecond g (Re p) = Re (p . first g)
{-# INLINE contrabimap #-}
{-# INLINE contrafirst #-}
{-# INLINE contrasecond #-}
instance Strong p => Costrong (Re p s t) where
unfirst (Re p) = Re (p . first')
unsecond (Re p) = Re (p . second')
{-# INLINE unfirst #-}
{-# INLINE unsecond #-}
instance Costrong p => Strong (Re p s t) where
first' (Re p) = Re (p . unfirst)
second' (Re p) = Re (p . unsecond)
{-# INLINE first' #-}
{-# INLINE second' #-}
ilinear _ = error "ilinear(Re) shouldn't be reachable"
instance Choice p => Cochoice (Re p s t) where
unleft (Re p) = Re (p . left')
unright (Re p) = Re (p . right')
{-# INLINE unleft #-}
{-# INLINE unright #-}
instance Cochoice p => Choice (Re p s t) where
left' (Re p) = Re (p . unleft)
right' (Re p) = Re (p . unright)
{-# INLINE left' #-}
{-# INLINE right' #-}
-- $setup
-- >>> import Data.Functor.Identity
-- >>> import Optics.Core