{-# LANGUAGE CPP #-}
-------------------------------------------------------------------------------

-- | This module provides conversion functions between the optics defined in

-- this library and 'Profunctor'-based optics.

--

-- The goal of these functions is to provide an interoperability layer between

-- the two styles of optics, and not to reimplement all the library in terms of

-- 'Profunctor' optics.


module Control.Lens.Profunctor
  ( -- * Profunctor optic

    OpticP

    -- * Conversion from Van Laarhoven optics

  , fromLens
  , fromIso
  , fromPrism
  , fromSetter
  , fromTraversal

    -- * Conversion to Van Laarhoven optics

  , toLens
  , toIso
  , toPrism
  , toSetter
  , toTraversal
  ) where

import Prelude ()

import Control.Lens.Internal.Prelude
import Control.Lens.Type (Optic, LensLike)
import Control.Lens.Internal.Context (Context (..), sell)
import Control.Lens.Internal.Profunctor (WrappedPafb (..))
import Control.Lens (ASetter, ATraversal, cloneTraversal, Settable)
import Data.Profunctor (Star (..))
import Data.Profunctor.Mapping (Mapping (..))
import Data.Profunctor.Traversing (Traversing (..))

-- | Profunctor optic.

type OpticP p s t a b = p a b -> p s t

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

-- Conversion from Van Laarhoven optics

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


-- | Converts a 'Control.Lens.Type.Lens' to a 'Profunctor'-based one.

--

-- @

-- 'fromLens' :: 'Control.Lens.Type.Lens' s t a b -> LensP s t a b

-- @

fromLens :: Strong p => LensLike (Context a b) s t a b -> OpticP p s t a b
fromLens :: forall (p :: * -> * -> *) a b s t.
Strong p =>
LensLike (Context a b) s t a b -> OpticP p s t a b
fromLens LensLike (Context a b) s t a b
l p a b
p =
  forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap
    (\s
s -> let Context b -> t
f a
a = LensLike (Context a b) s t a b
l forall (p :: * -> * -> *) (w :: * -> * -> * -> *) a b.
Sellable p w =>
p a (w a b b)
sell s
s in (b -> t
f, a
a))
    (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. a -> a
id)
    (forall (p :: * -> * -> *) a b c.
Strong p =>
p a b -> p (c, a) (c, b)
second' p a b
p)

-- | Converts a 'Control.Lens.Type.Iso' to a 'Profunctor'-based one.

--

-- @

-- 'fromIso' :: 'Control.Lens.Type.Iso' s t a b -> IsoP s t a b

-- @

fromIso :: Profunctor p => Optic p Identity s t a b -> OpticP p s t a b
fromIso :: forall (p :: * -> * -> *) s t a b.
Profunctor p =>
Optic p Identity s t a b -> OpticP p s t a b
fromIso Optic p Identity s t a b
p p a b
pab = forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap forall a. Identity a -> a
runIdentity (Optic p Identity s t a b
p (forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap forall a. a -> Identity a
Identity p a b
pab))

-- | Converts a 'Control.Lens.Type.Prism' to a 'Profunctor'-based one.

--

-- @

-- 'fromPrism' :: 'Control.Lens.Type.Prism' s t a b -> PrismP s t a b

-- @

fromPrism :: Choice p => Optic p Identity s t a b -> OpticP p s t a b
fromPrism :: forall (p :: * -> * -> *) s t a b.
Choice p =>
Optic p Identity s t a b -> OpticP p s t a b
fromPrism Optic p Identity s t a b
p p a b
pab = forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap forall a. Identity a -> a
runIdentity (Optic p Identity s t a b
p (forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap forall a. a -> Identity a
Identity p a b
pab))

-- | Converts a 'Control.Lens.Type.Setter' to a 'Profunctor'-based one.

--

-- @

-- 'fromSetter' :: 'Control.Lens.Type.Setter' s t a b -> SetterP s t a b

-- @

fromSetter :: Mapping p => ASetter s t a b -> OpticP p s t a b
fromSetter :: forall (p :: * -> * -> *) s t a b.
Mapping p =>
ASetter s t a b -> OpticP p s t a b
fromSetter ASetter s t a b
s = forall (p :: * -> * -> *) a b s t.
Mapping p =>
((a -> b) -> s -> t) -> p a b -> p s t
roam (a -> b) -> s -> t
s'
  where
    s' :: (a -> b) -> s -> t
s' a -> b
f = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter s t a b
s (forall a. a -> Identity a
Identity forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)

-- | Converts a 'Control.Lens.Type.Traversal' to a 'Profunctor'-based one.

--

-- @

-- 'fromTraversal' :: 'Control.Lens.Type.Traversal' s t a b -> TraversalP s t a b

-- @

fromTraversal :: Traversing p => ATraversal s t a b -> OpticP p s t a b
fromTraversal :: forall (p :: * -> * -> *) s t a b.
Traversing p =>
ATraversal s t a b -> OpticP p s t a b
fromTraversal ATraversal s t a b
l = forall (p :: * -> * -> *) a b s t.
Traversing p =>
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> p a b -> p s t
wander (forall s t a b. ATraversal s t a b -> Traversal s t a b
cloneTraversal ATraversal s t a b
l)

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

-- Conversion to Van Laarhoven optics

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


-- | Obtain a 'Control.Lens.Type.Prism' from a 'Profunctor'-based one.

--

-- @

-- 'toPrism' :: PrismP s t a b -> 'Control.Lens.Type.Prism' s t a b

-- @

toPrism :: (Choice p, Applicative f) => OpticP (WrappedPafb f p) s t a b -> Optic p f s t a b
toPrism :: forall (p :: * -> * -> *) (f :: * -> *) s t a b.
(Choice p, Applicative f) =>
OpticP (WrappedPafb f p) s t a b -> Optic p f s t a b
toPrism OpticP (WrappedPafb f p) s t a b
p = forall (f :: * -> *) (p :: * -> * -> *) a b.
WrappedPafb f p a b -> p a (f b)
unwrapPafb forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpticP (WrappedPafb f p) s t a b
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (p :: * -> * -> *) a b.
p a (f b) -> WrappedPafb f p a b
WrapPafb

-- | Obtain a 'Control.Lens.Type.Iso' from a 'Profunctor'-based one.

--

-- @

-- 'toIso' :: IsoP s t a b -> 'Control.Lens.Type.Iso' s t a b

-- @

toIso :: (Profunctor p, Functor f) => OpticP (WrappedPafb f p) s t a b -> Optic p f s t a b
toIso :: forall (p :: * -> * -> *) (f :: * -> *) s t a b.
(Profunctor p, Functor f) =>
OpticP (WrappedPafb f p) s t a b -> Optic p f s t a b
toIso OpticP (WrappedPafb f p) s t a b
p = forall (f :: * -> *) (p :: * -> * -> *) a b.
WrappedPafb f p a b -> p a (f b)
unwrapPafb forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpticP (WrappedPafb f p) s t a b
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (p :: * -> * -> *) a b.
p a (f b) -> WrappedPafb f p a b
WrapPafb

-- | Obtain a 'Control.Lens.Type.Lens' from a 'Profunctor'-based one.

--

-- @

-- 'toLens' :: LensP s t a b -> 'Control.Lens.Type.Lens' s t a b

-- @

toLens :: Functor f => OpticP (Star f) s t a b -> LensLike f s t a b
toLens :: forall (f :: * -> *) s t a b.
Functor f =>
OpticP (Star f) s t a b -> LensLike f s t a b
toLens OpticP (Star f) s t a b
p = forall {k} (f :: k -> *) d (c :: k). Star f d c -> d -> f c
runStar forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpticP (Star f) s t a b
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) d (c :: k). (d -> f c) -> Star f d c
Star

-- | Obtain a 'Control.Lens.Type.Setter' from a 'Profunctor'-based one.

--

-- @

-- 'toSetter' :: SetterP s t a b -> 'Control.Lens.Type.Setter' s t a b

-- @

toSetter :: Settable f => OpticP (Star f) s t a b -> LensLike f s t a b
toSetter :: forall (f :: * -> *) s t a b.
Settable f =>
OpticP (Star f) s t a b -> LensLike f s t a b
toSetter OpticP (Star f) s t a b
p = forall {k} (f :: k -> *) d (c :: k). Star f d c -> d -> f c
runStar forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpticP (Star f) s t a b
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) d (c :: k). (d -> f c) -> Star f d c
Star

-- | Obtain a 'Control.Lens.Type.Traversal' from a 'Profunctor'-based one.

--

-- @

-- 'toTraversal' :: TraversalP s t a b -> 'Control.Lens.Type.Traversal' s t a b

-- @

toTraversal :: Applicative f => OpticP (Star f) s t a b -> LensLike f s t a b
toTraversal :: forall (f :: * -> *) s t a b.
Applicative f =>
OpticP (Star f) s t a b -> LensLike f s t a b
toTraversal OpticP (Star f) s t a b
p = forall {k} (f :: k -> *) d (c :: k). Star f d c -> d -> f c
runStar forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpticP (Star f) s t a b
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) d (c :: k). (d -> f c) -> Star f d c
Star