{-# LANGUAGE CPP #-}
module Control.Lens.Profunctor
(
OpticP
, fromLens
, fromIso
, fromPrism
, fromSetter
, fromTraversal
, 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 (..))
type OpticP p s t a b = p a b -> p s t
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)
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))
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))
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)
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)
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
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
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
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
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