optics-core-0.4.1: Optics as an abstract interface: core definitions
Safe Haskell None
Language Haskell2010

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 Lens es 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 #

Is A_Lens A_Fold Source #
Instance details

Defined in Optics.Internal.Optic.Subtyping

Is A_Lens An_AffineFold Source #
Instance details

Defined in Optics.Internal.Optic.Subtyping

Is A_Lens A_Getter Source #
Instance details

Defined in Optics.Internal.Optic.Subtyping

Is A_Lens A_Setter Source #
Instance details

Defined in Optics.Internal.Optic.Subtyping

Is A_Lens A_Traversal Source #
Instance details

Defined in Optics.Internal.Optic.Subtyping

Is A_Lens An_AffineTraversal Source #
Instance details

Defined in Optics.Internal.Optic.Subtyping

Is An_Iso A_Lens Source #
Instance details

Defined in Optics.Internal.Optic.Subtyping

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 #

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

Defined in Optics.Internal.Optic.Subtyping

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

Defined in Optics.Internal.Optic.Subtyping

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

Defined in Optics.Internal.Optic.Subtyping

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

Defined in Optics.Internal.Optic.Subtyping

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

Defined in Optics.Internal.Optic.Subtyping

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

Defined in Optics.Internal.Optic.Subtyping

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

Defined in Optics.Internal.Optic.Subtyping

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

Defined in Optics.Internal.Optic.Subtyping

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

Defined in Optics.Internal.Optic.Subtyping

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

Defined in Optics.Internal.Optic.Subtyping

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

Defined in Optics.Internal.Optic.Subtyping

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

Defined in Optics.Internal.Optic.Subtyping

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

Defined in Optics.Internal.Optic.Subtyping

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

Defined in Optics.Internal.Optic.Subtyping

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

Defined in Optics.Internal.Optic.Subtyping

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

Defined in Optics.Internal.Optic.Subtyping

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

Defined in Optics.Internal.Optic.Subtyping

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

Defined in Optics.Internal.Optic.Subtyping

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

Defined in Optics.Internal.Optic.Subtyping

ToReadOnly A_Lens s t a b Source #
Instance details

Defined in Optics.ReadOnly

IxOptic A_Lens s t a b Source #
Instance details

Defined in Optics.Indexed.Core

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

Defined in Optics.Mapping

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 ReversedOptic A_Lens Source #
Instance details

Defined in Optics.Re

type ReadOnlyOptic A_Lens Source #
Instance details

Defined in Optics.ReadOnly

type MappedOptic A_Lens Source #
Instance details

Defined in Optics.Mapping

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.