{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Optics.VL
(
IsoVL
, IsoVL'
, isoVL
, PrismVL
, PrismVL'
, prismVL
, LensVL
, LensVL'
, lensVL
, IxLensVL
, IxLensVL'
, ilensVL
, AffineTraversalVL
, AffineTraversalVL'
, atraversalVL
, IxAffineTraversalVL
, IxAffineTraversalVL'
, iatraversalVL
, TraversalVL
, TraversalVL'
, traversalVL
, IxTraversalVL
, IxTraversalVL'
, itraversalVL
) where
import Data.Functor.Identity
import qualified Data.Profunctor as P
import Optics.Internal.Optic
import Optics.Internal.Profunctor
import Optics.Internal.Utils
import Optics.Core
newtype WrappedProfunctor p i a b =
WrapProfunctor { unwrapProfunctor :: p i a b }
instance Profunctor p => P.Profunctor (WrappedProfunctor p i) where
dimap f g (WrapProfunctor pab) = WrapProfunctor (dimap f g pab)
lmap f (WrapProfunctor pab) = WrapProfunctor (lmap f pab)
rmap g (WrapProfunctor pab) = WrapProfunctor (rmap g pab)
{-# INLINE dimap #-}
{-# INLINE lmap #-}
{-# INLINE rmap #-}
instance Choice p => P.Choice (WrappedProfunctor p i) where
left' (WrapProfunctor pab) = WrapProfunctor (left' pab)
right' (WrapProfunctor pab) = WrapProfunctor (right' pab)
{-# INLINE left' #-}
{-# INLINE right' #-}
type IsoVL s t a b =
forall p f. (P.Profunctor p, Functor f) => p a (f b) -> p s (f t)
type IsoVL' s a = IsoVL s s a a
isoVL :: forall s t a b. IsoVL s t a b -> Iso s t a b
isoVL f = Optic $ rcoerce @(Identity t) @t
. (unwrapProfunctor #. f .# WrapProfunctor)
. rcoerce @b @(Identity b)
{-# INLINE isoVL #-}
type PrismVL s t a b =
forall p f. (P.Choice p, Applicative f) => p a (f b) -> p s (f t)
type PrismVL' s a = PrismVL s s a a
prismVL :: forall s t a b. PrismVL s t a b -> Prism s t a b
prismVL f = Optic $ rcoerce @(Identity t) @t
. (unwrapProfunctor #. f .# WrapProfunctor)
. rcoerce @b @(Identity b)
{-# INLINE prismVL #-}