{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TupleSections #-}
module Data.Generics.Internal.VL.Lens where
import "generic-lens-core" Data.Generics.Internal.Profunctor.Lens (ALens (..), idLens)
import Control.Applicative (Const(..))
import Data.Coerce (coerce)
import Data.Functor.Identity (Identity(..))
type Lens' s a
= Lens s s a a
type Lens s t a b
= forall f. Functor f => (a -> f b) -> s -> f t
view :: ((a -> Const a a) -> s -> Const a s) -> s -> a
view :: ((a -> Const a a) -> s -> Const a s) -> s -> a
view (a -> Const a a) -> s -> Const a s
l s
s = s -> ((a -> Const a a) -> s -> Const a s) -> a
forall s a. s -> ((a -> Const a a) -> s -> Const a s) -> a
(^.) s
s (a -> Const a a) -> s -> Const a s
l
(^.) :: s -> ((a -> Const a a) -> s -> Const a s) -> a
s
s ^. :: s -> ((a -> Const a a) -> s -> Const a s) -> a
^. (a -> Const a a) -> s -> Const a s
l = Const a s -> a
forall a k (b :: k). Const a b -> a
getConst ((a -> Const a a) -> s -> Const a s
l a -> Const a a
forall k a (b :: k). a -> Const a b
Const s
s)
infixl 8 ^.
infixr 4 .~
(.~) :: ((a -> Identity b) -> s -> Identity t) -> b -> s -> t
.~ :: ((a -> Identity b) -> s -> Identity t) -> b -> s -> t
(.~) (a -> Identity b) -> s -> Identity t
f b
b = Identity t -> t
forall a. Identity a -> a
runIdentity (Identity t -> t) -> (s -> Identity t) -> s -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Identity b) -> s -> Identity t
f (b -> Identity b
forall a. a -> Identity a
Identity (b -> Identity b) -> (a -> b) -> a -> Identity b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a -> b
forall a b. a -> b -> a
const b
b)
set :: Lens s t a b -> b -> s -> t
set :: Lens s t a b -> b -> s -> t
set Lens s t a b
l b
x = (a -> Identity b) -> s -> Identity t
Lens s t a b
l ((a -> Identity b) -> s -> Identity t) -> b -> s -> t
forall a b s t.
((a -> Identity b) -> s -> Identity t) -> b -> s -> t
.~ b
x
over :: ((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t
over :: ((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t
over = ((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t
coerce
lens2lensvl :: ALens a b i s t -> Lens s t a b
lens2lensvl :: ALens a b i s t -> Lens s t a b
lens2lensvl (ALens s -> (c, a)
_get (c, b) -> t
_set) =
\a -> f b
f s
x ->
case s -> (c, a)
_get s
x of
(c
c, a
a) -> (c, b) -> t
_set ((c, b) -> t) -> (b -> (c, b)) -> b -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c
c, ) (b -> t) -> f b -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a
{-# INLINE lens2lensvl #-}
ravel :: (ALens a b i a b -> ALens a b i s t)
-> Lens s t a b
ravel :: (ALens a b i a b -> ALens a b i s t) -> Lens s t a b
ravel ALens a b i a b -> ALens a b i s t
l a -> f b
pab = (ALens a b i s t -> Lens s t a b
forall a b i s t. ALens a b i s t -> Lens s t a b
lens2lensvl (ALens a b i s t -> Lens s t a b)
-> ALens a b i s t -> Lens s t a b
forall a b. (a -> b) -> a -> b
$ ALens a b i a b -> ALens a b i s t
l ALens a b i a b
forall a b i. ALens a b i a b
idLens) a -> f b
pab
lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b
lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b
lens s -> a
get s -> b -> t
_set = \a -> f b
f s
x -> s -> b -> t
_set s
x (b -> t) -> f b -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f (s -> a
get s
x)
{-# INLINE lens #-}