lens -is:package

Build a Lens from a getter and a setter.
lens :: Functor f => (s -> a) -> (s -> b -> t) -> (a -> f b) -> s -> f t
>>> s ^. lens getter setter
getter s
>>> s & lens getter setter .~ b
setter s b
>>> s & lens getter setter %~ f
setter s (f (getter s))
lens :: (s -> a) -> (s -> a -> s) -> Lens' s a
lens creates a Lens from a getter and a setter. The resulting lens isn't the most effective one (because of having to traverse the structure twice when modifying), but it shouldn't matter much. A (partial) lens for list indexing:
ix :: Int -> Lens' [a] a
ix i = lens (!! i)                                   -- getter
(\s b -> take i s ++ b : drop (i+1) s)   -- setter
Usage:
>>> [1..9] ^. ix 3
4

>>> [1..9] & ix 3 %~ negate
[1,2,3,-4,5,6,7,8,9]
When getting, the setter is completely unused; when setting, the getter is unused. Both are used only when the value is being modified. For instance, here we define a lens for the 1st element of a list, but instead of a legitimate getter we use undefined. Then we use the resulting lens for setting and it works, which proves that the getter wasn't used:
>>> [1,2,3] & lens undefined (\s b -> b : tail s) .~ 10
[10,2,3]
Creates Lens' from the getter and setter.
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.
Build a lens from a getter and setter family. Caution: In order for the generated lens family to be well-defined, you must ensure that the three lens laws hold:
  • getter (setter s a) === a
  • setter s (getter s) === s
  • setter (setter s a1) a2 === setter s a2
My lens creation function to avoid a dependency on lens.
lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b
Build a lens from a getter and setter family. Caution: In order for the generated lens family to be well-defined, you must ensure that the three lens laws hold:
  • getter (setter s a) === a
  • setter s (getter s) === s
  • setter (setter s a1) a2 === setter s a2
Build a lens out of a getter and setter
Make a lens out of the label. Example: over (lens #salary) (* 1.1) employee
Control.Exception provides an example of a large open hierarchy that we can model with prisms and isomorphisms. Additional combinators for working with IOException results can be found in System.IO.Error.Lens. The combinators in this module have been generalized to work with MonadCatch instead of just IO. This enables them to be used more easily in Monad transformer stacks.
You can derive lenses automatically for many data types:
import Control.Lens

data FooBar a
= Foo { _x :: [Int], _y :: a }
| Bar { _x :: [Int] }
makeLenses ''FooBar
This defines the following lenses:
x :: Lens' (FooBar a) [Int]
y :: Traversal (FooBar a) (FooBar b) a b
You can then access the value of _x with (^.), the value of _y – with (^?) or (^?!) (since it can fail), set the values with (.~), modify them with (%~), and use almost any other combinator that is re-exported here on those fields. The combinators here have unusually specific type signatures, so for particularly tricky ones, the simpler type signatures you might want to pretend the combinators have are specified as well. More information on how to use lenses is available on the lens wiki: http://github.com/ekmett/lens/wiki
A Lens is actually a lens family as described in http://comonad.com/reader/2012/mirrored-lenses/. With great power comes great responsibility and a Lens is subject to the three common sense Lens laws: 1) You get back what you put in:
view l (set l v s)  ≡ v
2) Putting back what you got doesn't change anything:
set l (view l s) s  ≡ s
3) Setting twice is the same as setting once:
set l v' (set l v s) ≡ set l v' s
These laws are strong enough that the 4 type parameters of a Lens cannot vary fully independently. For more on how they interact, read the "Why is it a Lens Family?" section of http://comonad.com/reader/2012/mirrored-lenses/. There are some emergent properties of these laws: 1) set l s must be injective for every s This is a consequence of law #1 2) set l must be surjective, because of law #2, which indicates that it is possible to obtain any v from some s such that set s v = s 3) Given just the first two laws you can prove a weaker form of law #3 where the values v that you are setting match:
set l v (set l v s) ≡ set l v s
Every Lens can be used directly as a Setter or Traversal. You can also use a Lens for Getting as if it were a Fold or Getter. Since every Lens is a valid Traversal, the Traversal laws are required of any Lens you create:
l purepure
fmap (l f) . l g ≡ getCompose . l (Compose . fmap f . g)
type Lens s t a b = forall f. Functor f => LensLike f s t a b
A Lens s t a b is a purely functional reference. While a Traversal could be used for Getting like a valid Fold, it wasn't a valid Getter as a Getter can't require an Applicative constraint. Functor, however, is a constraint on both.
type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
Every Lens is a valid Setter. Every Lens can be used for Getting like a Fold that doesn't use the Applicative or Contravariant. Every Lens is a valid Traversal that only uses the Functor part of the Applicative it is supplied. Every Lens can be used for Getting like a valid Getter. Since every Lens can be used for Getting like a valid Getter it follows that it must view exactly one element in the structure. The Lens laws follow from this property and the desire for it to act like a Traversable when used as a Traversal. In the examples below, getter and setter are supplied as example getters and setters, and are not actual functions supplied by this package.
A Lens or Traversal can be used to take the role of Traversable in Control.Parallel.Strategies, enabling those combinators to work with monomorphic containers.
A Fold can be used to take the role of Foldable in Control.Seq.
Lazy ByteString lenses.
Lenses and traversals for complex numbers