optics-core-0.4.1.1: Optics as an abstract interface: core definitions
Safe HaskellSafe-Inferred
LanguageHaskell2010

Optics.Lens

Description

A Lens is a generalised or first-class field.

If we have a value s :: S, and a l :: Lens' S A, we can get the "field value" of type A using view l s. We can also update (or put or set) the value using over (or set).

For example, given the following definitions:

>>> data Human = Human { _name :: String, _location :: String } deriving Show
>>> let human = Human "Bob" "London"

we can make a Lens for _name field:

>>> let name = lens _name $ \s x -> s { _name = x }

which we can use as a Getter:

>>> view name human
"Bob"

or a Setter:

>>> set name "Robert" human
Human {_name = "Robert", _location = "London"}
Synopsis

Formation

type Lens s t a b = Optic A_Lens NoIx s t a b Source #

Type synonym for a type-modifying lens.

type Lens' s a = Optic' A_Lens NoIx s a Source #

Type synonym for a type-preserving lens.

Introduction

lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b Source #

Build a lens from a getter and a setter, which must respect the well-formedness laws.

If you want to build a Lens from the van Laarhoven representation, use lensVL.

Elimination

A Lens is in particular a Getter and a Setter, therefore you can specialise types to obtain:

view :: Lens' s a -> s -> a
over :: Lens s t a b -> (a -> b) -> s -> t
set  :: Lens s t a b ->       b  -> s -> t

If you want to view a type-modifying Lens that is insufficiently polymorphic to be used as a type-preserving Lens', use getting:

view . getting :: Lens s t a b -> s -> a

Computation

view (lens f g)   s ≡ f s
set  (lens f g) a s ≡ g s a

Well-formedness

  • GetPut: You get back what you put in:

    view l (set l v s) ≡ v
    
  • PutGet: Putting back what you got doesn’t change anything:

    set l (view l s) s ≡ s
    
  • PutPut: Setting twice is the same as setting once:

    set l v' (set l v s) ≡ set l v' s
    

Additional introduction forms

See Data.Tuple.Optics for Lenses for tuples.

If you're looking for chosen, it was moved to Optics.IxLens.

equality' :: Lens a b a b Source #

Strict version of equality.

Useful for strictifying optics with lazy (irrefutable) pattern matching by precomposition, e.g.

_1' = equality' % _1

alongside :: (Is k A_Lens, Is l A_Lens) => Optic k is s t a b -> Optic l js s' t' a' b' -> Lens (s, s') (t, t') (a, a') (b, b') Source #

Make a Lens from two other lenses by executing them on their respective halves of a product.

>>> (Left 'a', Right 'b') ^. alongside chosen chosen
('a','b')
>>> (Left 'a', Right 'b') & alongside chosen chosen .~ ('c','d')
(Left 'c',Right 'd')

united :: Lens' a () Source #

We can always retrieve a () from any type.

>>> view united "hello"
()
>>> set united () "hello"
"hello"

Additional elimination forms

withLens :: Is k A_Lens => Optic k is s t a b -> ((s -> a) -> (s -> b -> t) -> r) -> r Source #

Work with a lens as a getter and a setter.

withLens (lens f g) k ≡ k f g

Subtyping

data A_Lens :: OpticKind Source #

Tag for a lens.

Instances

Instances details
ReversibleOptic A_Lens Source # 
Instance details

Defined in Optics.Re

Associated Types

type ReversedOptic A_Lens = (r :: Type) Source #

Methods

re :: forall (is :: IxList) s t a b. AcceptsEmptyIndices "re" is => Optic A_Lens is s t a b -> Optic (ReversedOptic A_Lens) is b a t s Source #

Arrow arr => ArrowOptic A_Lens arr Source # 
Instance details

Defined in Optics.Arrow

Methods

overA :: forall (is :: IxList) s t a b. Optic A_Lens is s t a b -> arr a b -> arr s t Source #

Is A_Lens A_Fold Source # 
Instance details

Defined in Optics.Internal.Optic.Subtyping

Methods

implies :: forall (p :: Type -> Type -> Type -> Type) r. (Constraints A_Lens p => r) -> Constraints A_Fold p => r Source #

Is A_Lens A_Getter Source # 
Instance details

Defined in Optics.Internal.Optic.Subtyping

Methods

implies :: forall (p :: Type -> Type -> Type -> Type) r. (Constraints A_Lens p => r) -> Constraints A_Getter p => r Source #

Is A_Lens A_Setter Source # 
Instance details

Defined in Optics.Internal.Optic.Subtyping

Methods

implies :: forall (p :: Type -> Type -> Type -> Type) r. (Constraints A_Lens p => r) -> Constraints A_Setter p => r Source #

Is A_Lens A_Traversal Source # 
Instance details

Defined in Optics.Internal.Optic.Subtyping

Methods

implies :: forall (p :: Type -> Type -> Type -> Type) r. (Constraints A_Lens p => r) -> Constraints A_Traversal p => r Source #

Is A_Lens An_AffineFold Source # 
Instance details

Defined in Optics.Internal.Optic.Subtyping

Methods

implies :: forall (p :: Type -> Type -> Type -> Type) r. (Constraints A_Lens p => r) -> Constraints An_AffineFold p => r Source #

Is A_Lens An_AffineTraversal Source # 
Instance details

Defined in Optics.Internal.Optic.Subtyping

Methods

implies :: forall (p :: Type -> Type -> Type -> Type) r. (Constraints A_Lens p => r) -> Constraints An_AffineTraversal p => r Source #

Is An_Iso A_Lens Source # 
Instance details

Defined in Optics.Internal.Optic.Subtyping

Methods

implies :: forall (p :: Type -> Type -> Type -> Type) r. (Constraints An_Iso p => r) -> Constraints A_Lens p => r Source #

k ~ A_Fold => JoinKinds A_Fold A_Lens k Source # 
Instance details

Defined in Optics.Internal.Optic.Subtyping

Methods

joinKinds :: forall (p :: Type -> Type -> Type -> Type) r. ((Constraints A_Fold p, Constraints A_Lens p) => r) -> Constraints k p => r Source #

k ~ A_Getter => JoinKinds A_Getter A_Lens k Source # 
Instance details

Defined in Optics.Internal.Optic.Subtyping

Methods

joinKinds :: forall (p :: Type -> Type -> Type -> Type) r. ((Constraints A_Getter p, Constraints A_Lens p) => r) -> Constraints k p => r Source #

k ~ A_Fold => JoinKinds A_Lens A_Fold k Source # 
Instance details

Defined in Optics.Internal.Optic.Subtyping

Methods

joinKinds :: forall (p :: Type -> Type -> Type -> Type) r. ((Constraints A_Lens p, Constraints A_Fold p) => r) -> Constraints k p => r Source #

k ~ A_Getter => JoinKinds A_Lens A_Getter k Source # 
Instance details

Defined in Optics.Internal.Optic.Subtyping

Methods

joinKinds :: forall (p :: Type -> Type -> Type -> Type) r. ((Constraints A_Lens p, Constraints A_Getter p) => r) -> Constraints k p => r Source #

k ~ A_Lens => JoinKinds A_Lens A_Lens k Source # 
Instance details

Defined in Optics.Internal.Optic.Subtyping

Methods

joinKinds :: forall (p :: Type -> Type -> Type -> Type) r. ((Constraints A_Lens p, Constraints A_Lens p) => r) -> Constraints k p => r Source #

k ~ An_AffineTraversal => JoinKinds A_Lens A_Prism k Source # 
Instance details

Defined in Optics.Internal.Optic.Subtyping

Methods

joinKinds :: forall (p :: Type -> Type -> Type -> Type) r. ((Constraints A_Lens p, Constraints A_Prism p) => r) -> Constraints k p => r Source #

k ~ A_Getter => JoinKinds A_Lens A_ReversedPrism k Source # 
Instance details

Defined in Optics.Internal.Optic.Subtyping

Methods

joinKinds :: forall (p :: Type -> Type -> Type -> Type) r. ((Constraints A_Lens p, Constraints A_ReversedPrism p) => r) -> Constraints k p => r Source #

k ~ A_Setter => JoinKinds A_Lens A_Setter k Source # 
Instance details

Defined in Optics.Internal.Optic.Subtyping

Methods

joinKinds :: forall (p :: Type -> Type -> Type -> Type) r. ((Constraints A_Lens p, Constraints A_Setter p) => r) -> Constraints k p => r Source #

k ~ A_Traversal => JoinKinds A_Lens A_Traversal k Source # 
Instance details

Defined in Optics.Internal.Optic.Subtyping

Methods

joinKinds :: forall (p :: Type -> Type -> Type -> Type) r. ((Constraints A_Lens p, Constraints A_Traversal p) => r) -> Constraints k p => r Source #

k ~ An_AffineFold => JoinKinds A_Lens An_AffineFold k Source # 
Instance details

Defined in Optics.Internal.Optic.Subtyping

Methods

joinKinds :: forall (p :: Type -> Type -> Type -> Type) r. ((Constraints A_Lens p, Constraints An_AffineFold p) => r) -> Constraints k p => r Source #

k ~ An_AffineTraversal => JoinKinds A_Lens An_AffineTraversal k Source # 
Instance details

Defined in Optics.Internal.Optic.Subtyping

Methods

joinKinds :: forall (p :: Type -> Type -> Type -> Type) r. ((Constraints A_Lens p, Constraints An_AffineTraversal p) => r) -> Constraints k p => r Source #

k ~ A_Lens => JoinKinds A_Lens An_Iso k Source # 
Instance details

Defined in Optics.Internal.Optic.Subtyping

Methods

joinKinds :: forall (p :: Type -> Type -> Type -> Type) r. ((Constraints A_Lens p, Constraints An_Iso p) => r) -> Constraints k p => r Source #

k ~ An_AffineTraversal => JoinKinds A_Prism A_Lens k Source # 
Instance details

Defined in Optics.Internal.Optic.Subtyping

Methods

joinKinds :: forall (p :: Type -> Type -> Type -> Type) r. ((Constraints A_Prism p, Constraints A_Lens p) => r) -> Constraints k p => r Source #

k ~ A_Getter => JoinKinds A_ReversedPrism A_Lens k Source # 
Instance details

Defined in Optics.Internal.Optic.Subtyping

Methods

joinKinds :: forall (p :: Type -> Type -> Type -> Type) r. ((Constraints A_ReversedPrism p, Constraints A_Lens p) => r) -> Constraints k p => r Source #

k ~ A_Setter => JoinKinds A_Setter A_Lens k Source # 
Instance details

Defined in Optics.Internal.Optic.Subtyping

Methods

joinKinds :: forall (p :: Type -> Type -> Type -> Type) r. ((Constraints A_Setter p, Constraints A_Lens p) => r) -> Constraints k p => r Source #

k ~ A_Traversal => JoinKinds A_Traversal A_Lens k Source # 
Instance details

Defined in Optics.Internal.Optic.Subtyping

Methods

joinKinds :: forall (p :: Type -> Type -> Type -> Type) r. ((Constraints A_Traversal p, Constraints A_Lens p) => r) -> Constraints k p => r Source #

k ~ An_AffineFold => JoinKinds An_AffineFold A_Lens k Source # 
Instance details

Defined in Optics.Internal.Optic.Subtyping

Methods

joinKinds :: forall (p :: Type -> Type -> Type -> Type) r. ((Constraints An_AffineFold p, Constraints A_Lens p) => r) -> Constraints k p => r Source #

k ~ An_AffineTraversal => JoinKinds An_AffineTraversal A_Lens k Source # 
Instance details

Defined in Optics.Internal.Optic.Subtyping

Methods

joinKinds :: forall (p :: Type -> Type -> Type -> Type) r. ((Constraints An_AffineTraversal p, Constraints A_Lens p) => r) -> Constraints k p => r Source #

k ~ A_Lens => JoinKinds An_Iso A_Lens k Source # 
Instance details

Defined in Optics.Internal.Optic.Subtyping

Methods

joinKinds :: forall (p :: Type -> Type -> Type -> Type) r. ((Constraints An_Iso p, Constraints A_Lens p) => r) -> Constraints k p => r Source #

IxOptic A_Lens s t a b Source # 
Instance details

Defined in Optics.Indexed.Core

Methods

noIx :: forall (is :: IxList). NonEmptyIndices is => Optic A_Lens is s t a b -> Optic A_Lens NoIx s t a b Source #

ToReadOnly A_Lens s t a b Source # 
Instance details

Defined in Optics.ReadOnly

Associated Types

type ReadOnlyOptic A_Lens Source #

Methods

getting :: forall (is :: IxList). Optic A_Lens is s t a b -> Optic' (ReadOnlyOptic A_Lens) is s a Source #

(Functor f, f ~ g, s ~ t, a ~ b) => MappingOptic A_Lens f g s t a b Source # 
Instance details

Defined in Optics.Mapping

Associated Types

type MappedOptic A_Lens Source #

Methods

mapping :: forall (is :: IxList). AcceptsEmptyIndices "mapping" is => Optic A_Lens is s t a b -> Optic (MappedOptic A_Lens) is (f s) (g t) (f a) (g b) Source #

type MappedOptic A_Lens Source # 
Instance details

Defined in Optics.Mapping

type ReversedOptic A_Lens Source # 
Instance details

Defined in Optics.Re

type ReadOnlyOptic A_Lens Source # 
Instance details

Defined in Optics.ReadOnly

van Laarhoven encoding

The van Laarhoven encoding of lenses is isomorphic to the profunctor encoding used internally by optics, but converting back and forth may have a performance penalty.

type LensVL s t a b = forall f. Functor f => (a -> f b) -> s -> f t Source #

Type synonym for a type-modifying van Laarhoven lens.

type LensVL' s a = LensVL s s a a Source #

Type synonym for a type-preserving van Laarhoven lens.

lensVL :: LensVL s t a b -> Lens s t a b Source #

Build a lens from the van Laarhoven representation.

toLensVL :: Is k A_Lens => Optic k is s t a b -> LensVL s t a b Source #

Convert a lens to the van Laarhoven representation.

withLensVL :: Is k A_Lens => Optic k is s t a b -> (LensVL s t a b -> r) -> r Source #

Work with a lens in the van Laarhoven representation.