{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE RankNTypes #-}
module Control.Lens
( (&)
, Iso, Iso', iso
, from
, review, ( # )
, Lens, Lens', lens
, view, (^.)
, set, assign, (.=)
) where
import Control.Applicative
import Control.Monad.Identity
import Control.Monad.State.Class as State
import Data.Profunctor
import Data.Profunctor.Unsafe
import Unsafe.Coerce
(&) :: a -> (a -> b) -> b
a :: a
a & :: a -> (a -> b) -> b
& f :: a -> b
f = a -> b
f a
a
{-# INLINE (&) #-}
type Overloaded p f s t a b = p a (f b) -> p s (f t)
type Iso s t a b = forall p f. (Profunctor p, Functor f) => Overloaded p f s t a b
type Iso' s a = Iso s s a a
iso :: (s -> a) -> (b -> t) -> Iso s t a b
iso :: (s -> a) -> (b -> t) -> Iso s t a b
iso sa :: s -> a
sa bt :: b -> t
bt = (s -> a) -> (f b -> f t) -> p a (f b) -> p s (f t)
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap s -> a
sa ((b -> t) -> f b -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> t
bt)
{-# INLINE iso #-}
data Exchange a b s t = Exchange (s -> a) (b -> t)
instance Profunctor (Exchange a b) where
dimap :: (a -> b) -> (c -> d) -> Exchange a b b c -> Exchange a b a d
dimap f :: a -> b
f g :: c -> d
g (Exchange sa :: b -> a
sa bt :: b -> c
bt) = (a -> a) -> (b -> d) -> Exchange a b a d
forall a b s t. (s -> a) -> (b -> t) -> Exchange a b s t
Exchange (b -> a
sa (b -> a) -> (a -> b) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) (c -> d
g (c -> d) -> (b -> c) -> b -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> c
bt)
{-# INLINE dimap #-}
lmap :: (a -> b) -> Exchange a b b c -> Exchange a b a c
lmap f :: a -> b
f (Exchange sa :: b -> a
sa bt :: b -> c
bt) = (a -> a) -> (b -> c) -> Exchange a b a c
forall a b s t. (s -> a) -> (b -> t) -> Exchange a b s t
Exchange (b -> a
sa (b -> a) -> (a -> b) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) b -> c
bt
{-# INLINE lmap #-}
rmap :: (b -> c) -> Exchange a b a b -> Exchange a b a c
rmap f :: b -> c
f (Exchange sa :: a -> a
sa bt :: b -> b
bt) = (a -> a) -> (b -> c) -> Exchange a b a c
forall a b s t. (s -> a) -> (b -> t) -> Exchange a b s t
Exchange a -> a
sa (b -> c
f (b -> c) -> (b -> b) -> b -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> b
bt)
{-# INLINE rmap #-}
( #. ) _ = Exchange a b a b -> Exchange a b a c
forall a b. a -> b
unsafeCoerce
{-# INLINE ( #. ) #-}
( .# ) p :: Exchange a b b c
p _ = Exchange a b b c -> Exchange a b a c
forall a b. a -> b
unsafeCoerce Exchange a b b c
p
{-# INLINE ( .# ) #-}
type AnIso s t a b = Overloaded (Exchange a b) Identity s t a b
from :: AnIso s t a b -> Iso b a t s
from :: AnIso s t a b -> Iso b a t s
from l :: AnIso s t a b
l = case AnIso s t a b
l ((a -> a) -> (b -> Identity b) -> Exchange a b a (Identity b)
forall a b s t. (s -> a) -> (b -> t) -> Exchange a b s t
Exchange a -> a
forall a. a -> a
id b -> Identity b
forall a. a -> Identity a
Identity) of
Exchange sa :: s -> a
sa bt :: b -> Identity t
bt -> (b -> t) -> (s -> a) -> Iso b a t s
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (Identity t -> t
forall a. Identity a -> a
runIdentity (Identity t -> t) -> (b -> Identity t) -> b -> t
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. b -> Identity t
bt) s -> a
sa
{-# INLINE from #-}
newtype Reviewed a b = Reviewed
{ Reviewed a b -> b
runReviewed :: b
} deriving (a -> Reviewed a b -> Reviewed a a
(a -> b) -> Reviewed a a -> Reviewed a b
(forall a b. (a -> b) -> Reviewed a a -> Reviewed a b)
-> (forall a b. a -> Reviewed a b -> Reviewed a a)
-> Functor (Reviewed a)
forall a b. a -> Reviewed a b -> Reviewed a a
forall a b. (a -> b) -> Reviewed a a -> Reviewed a b
forall a a b. a -> Reviewed a b -> Reviewed a a
forall a a b. (a -> b) -> Reviewed a a -> Reviewed a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Reviewed a b -> Reviewed a a
$c<$ :: forall a a b. a -> Reviewed a b -> Reviewed a a
fmap :: (a -> b) -> Reviewed a a -> Reviewed a b
$cfmap :: forall a a b. (a -> b) -> Reviewed a a -> Reviewed a b
Functor)
instance Profunctor Reviewed where
dimap :: (a -> b) -> (c -> d) -> Reviewed b c -> Reviewed a d
dimap _ f :: c -> d
f (Reviewed c :: c
c) = d -> Reviewed a d
forall a b. b -> Reviewed a b
Reviewed (c -> d
f c
c)
{-# INLINE dimap #-}
lmap :: (a -> b) -> Reviewed b c -> Reviewed a c
lmap _ (Reviewed c :: c
c) = c -> Reviewed a c
forall a b. b -> Reviewed a b
Reviewed c
c
{-# INLINE lmap #-}
rmap :: (b -> c) -> Reviewed a b -> Reviewed a c
rmap = (b -> c) -> Reviewed a b -> Reviewed a c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
{-# INLINE rmap #-}
Reviewed b :: c
b .# :: Reviewed b c -> q a b -> Reviewed a c
.# _ = c -> Reviewed a c
forall a b. b -> Reviewed a b
Reviewed c
b
{-# INLINE ( .# ) #-}
( #. ) _ = Reviewed a b -> Reviewed a c
forall a b. a -> b
unsafeCoerce
{-# INLINE ( #. ) #-}
type AReview s t a b = Overloaded Reviewed Identity s t a b
review :: AReview s t a b -> b -> t
review :: AReview s t a b -> b -> t
review p :: AReview s t a b
p = Identity t -> t
forall a. Identity a -> a
runIdentity (Identity t -> t)
-> (Reviewed a (Identity b) -> Identity t)
-> Reviewed a (Identity b)
-> t
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. Reviewed s (Identity t) -> Identity t
forall a b. Reviewed a b -> b
runReviewed (Reviewed s (Identity t) -> Identity t)
-> AReview s t a b -> Reviewed a (Identity b) -> Identity t
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. AReview s t a b
p (Reviewed a (Identity b) -> t)
-> (Identity b -> Reviewed a (Identity b)) -> Identity b -> t
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# Identity b -> Reviewed a (Identity b)
forall a b. b -> Reviewed a b
Reviewed (Identity b -> t) -> (b -> Identity b) -> b -> t
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# b -> Identity b
forall a. a -> Identity a
Identity
{-# INLINE review #-}
infixr 8 #
( # ) :: AReview s t a b -> b -> t
( # ) = AReview s t a b -> b -> t
forall s t a b. AReview s t a b -> b -> t
review
{-# INLINE ( # ) #-}
type Lens s t a b = forall f. Functor f => Overloaded (->) f s t a b
type Lens' s a = Lens s s a a
lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b
lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b
lens sa :: s -> a
sa sbt :: s -> b -> t
sbt afb :: a -> f b
afb s :: s
s = s -> b -> t
sbt s
s (b -> t) -> f b -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
afb (s -> a
sa s
s)
{-# INLINE lens #-}
type Getting r s a = Overloaded (->) (Const r) s s a a
view :: Getting a s a -> s -> a
view :: Getting a s a -> s -> a
view l :: Getting a s a
l s :: s
s = Const a s -> a
forall a k (b :: k). Const a b -> a
getConst (Getting a s a
l a -> Const a a
forall k a (b :: k). a -> Const a b
Const s
s)
{-# INLINE view #-}
infixl 8 ^.
(^.) :: s -> Getting a s a -> a
^. :: s -> Getting a s a -> a
(^.) = (Getting a s a -> s -> a) -> s -> Getting a s a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Getting a s a -> s -> a
forall a s. Getting a s a -> s -> a
view
{-# INLINE (^.) #-}
type Setter s t a b = Overloaded (->) Identity s t a b
set :: Setter s t a b -> b -> s -> t
set :: Setter s t a b -> b -> s -> t
set l :: Setter s t a b
l b :: b
b = Identity t -> t
forall a. Identity a -> a
runIdentity (Identity t -> t) -> (s -> Identity t) -> s -> t
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. Setter s t a b
l (\ _ -> b -> Identity b
forall a. a -> Identity a
Identity b
b)
{-# INLINE set #-}
assign :: (MonadState s m) => Setter s s a b -> b -> m ()
assign :: Setter s s a b -> b -> m ()
assign l :: Setter s s a b
l b :: b
b = (s -> s) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (Setter s s a b -> b -> s -> s
forall s t a b. Setter s t a b -> b -> s -> t
set Setter s s a b
l b
b)
{-# INLINE assign #-}
infix 4 .=
(.=) :: (MonadState s m) => Setter s s a b -> b -> m ()
.= :: Setter s s a b -> b -> m ()
(.=) = Setter s s a b -> b -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
Setter s s a b -> b -> m ()
assign
{-# INLINE (.=) #-}