lens 2.8 → 2.9
raw patch · 33 files changed
+986/−368 lines, 33 filesdep ~basedep ~comonaddep ~comonads-fdPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base, comonad, comonads-fd, doctest, transformers
API changes (from Hackage documentation)
- Control.Exception.Lens: traverseException :: (Exception a, Exception b) => Traversal SomeException SomeException a b
- Control.Lens.Combinators: (|>) :: a -> (a -> b) -> b
- Control.Lens.Type: merged :: Functor f => LensLike f a b c c -> LensLike f a' b' c c -> LensLike f (Either a a') (Either b b') c c
- Data.Dynamic.Lens: traverseDynamic :: (Typeable a, Typeable b) => Traversal Dynamic Dynamic a b
+ Control.Exception.Lens: exception :: (Exception a, Exception b) => Projection SomeException SomeException a b
+ Control.Lens.Action: performs :: Monad m => Acting m e a b c d -> (c -> e) -> a -> m e
+ Control.Lens.Getter: (%) :: a -> (a -> b) -> b
+ Control.Lens.Getter: (^%) :: a -> (a -> b) -> b
+ Control.Lens.Getter: class Functor f => Gettable f
+ Control.Lens.Getter: data Accessor r a
+ Control.Lens.Projection: Project :: (d -> a) -> (x -> y) -> Project a d x y
+ Control.Lens.Projection: by :: Project a d (d -> Identity d) (a -> Identity a) -> Getter d a
+ Control.Lens.Projection: class Projective k a d
+ Control.Lens.Projection: data Project a d x y
+ Control.Lens.Projection: instance (a ~ a', d ~ d') => Projective (Project a d) a' d'
+ Control.Lens.Projection: instance Projective (->) a d
+ Control.Lens.Projection: mirror :: Projective k a c => Simple Iso a c -> Simple Projection a c
+ Control.Lens.Projection: project :: Projective k a d => Overloaded (Project a d) f a a c d -> Overloaded k f a a c d
+ Control.Lens.Projection: projection :: (d -> a) -> (a -> Maybe c) -> Projection a b c d
+ Control.Lens.Projection: projective :: Projective k a d => (d -> a) -> (x -> y) -> k x y
+ Control.Lens.Projection: stereo :: Projective k a c => Project b c y z -> Project a b x y -> k x z
+ Control.Lens.Projection: type SimpleProjection a b = Projection a a b b
+ Control.Lens.Projection: type Projection a b c d = forall k f. (Projective k a d, Applicative f) => k (c -> f d) (a -> f a)
+ Control.Lens.Setter: class Applicative f => Settable f
+ Control.Lens.Setter: data Mutator a
+ Control.Lens.Type: (<<%=) :: MonadState a m => LensLike ((,) c) a a c d -> (c -> d) -> m c
+ Control.Lens.Type: (<<%~) :: LensLike ((,) c) a b c d -> (c -> d) -> a -> (c, b)
+ Control.Lens.Type: (<<.=) :: MonadState a m => LensLike ((,) c) a a c d -> d -> m c
+ Control.Lens.Type: (<<.~) :: LensLike ((,) c) a b c d -> d -> a -> (c, b)
+ Control.Lens.Type: choosing :: Functor f => LensLike f a b c c -> LensLike f a' b' c c -> LensLike f (Either a a') (Either b b') c c
+ Control.Lens.Type: chosen :: Lens (Either a a) (Either b b) a b
+ Data.Dynamic.Lens: dynamic :: (Typeable a, Typeable b) => Projection Dynamic Dynamic a b
- Control.Lens.Type: alongside :: Lens a b c d -> Lens a' b' c' d' -> Lens (a, a') (b, b') (c, c') (d, d')
+ Control.Lens.Type: alongside :: LensLike (Context c d) a b c d -> LensLike (Context c' d') a' b' c' d' -> Lens (a, a') (b, b') (c, c') (d, d')
Files
- .gitignore +1/−0
- .travis.yml +2/−2
- CHANGELOG.markdown +19/−0
- README.markdown +285/−20
- benchmarks/alongside.hs +109/−0
- examples/Aeson.hs +25/−0
- lens.cabal +42/−17
- src/Control/Exception/Lens.hs +7/−9
- src/Control/Lens.hs +3/−1
- src/Control/Lens/Action.hs +8/−2
- src/Control/Lens/Combinators.hs +1/−15
- src/Control/Lens/Fold.hs +3/−14
- src/Control/Lens/Getter.hs +35/−6
- src/Control/Lens/IndexedLens.hs +3/−2
- src/Control/Lens/IndexedTraversal.hs +3/−1
- src/Control/Lens/Iso.hs +13/−8
- src/Control/Lens/Projection.hs +74/−0
- src/Control/Lens/Setter.hs +7/−16
- src/Control/Lens/TH.hs +43/−43
- src/Control/Lens/Traversal.hs +56/−16
- src/Control/Lens/Tuple.hs +3/−2
- src/Control/Lens/Type.hs +107/−13
- src/Control/Lens/WithIndex.hs +3/−1
- src/Control/Lens/Zoom.hs +0/−48
- src/Data/Complex/Lens.hs +8/−3
- src/Data/Dynamic/Lens.hs +7/−8
- src/Data/HashSet/Lens.hs +10/−9
- src/Data/IntSet/Lens.hs +9/−7
- src/Data/Sequence/Lens.hs +1/−1
- src/Data/Set/Lens.hs +11/−10
- src/Data/Tree/Lens.hs +5/−0
- src/Data/Typeable/Lens.hs +2/−2
- tests/hunit.hs +81/−92
.gitignore view
@@ -3,3 +3,4 @@ wiki TAGS tags+wip
.travis.yml view
@@ -8,8 +8,8 @@ # adding the hunit test suite causes us to have to reinstall regex-posix and regex-base - cabal install --only-dependencies --enable-tests --enable-benchmarks --force-reinstall install:- # we have to configure rather than install to get benchmarks- - cabal configure --enable-tests --enable-benchmarks+ # we have to configure rather than install in order to get benchmarks+ - cabal configure --enable-tests --enable-benchmarks -fdump-splices - cabal build script: - cabal test --show-details=always
CHANGELOG.markdown view
@@ -1,6 +1,25 @@+2.9+-----+* Added `<<%~`, `<<.~`, `<<%=` and `<<.=` for accessing the old values targeted by a `Lens` (or a summary of those targeted by a `Traversal`)+* Renamed `|>` to `%`, as `%~` is the lensed version of `%`, and moved it to `Control.Lens.Getter` along with a version `^%` with tighter+ precedence that can be interleaved with `^.`+* Upgraded to `doctest` 0.9, which lets us factor out common `$setup` for our doctests+* Renamed `merged` to `choosing`. Added a simpler `chosen` operation to mirror `both`.+* Added `Control.Lens.Projection`+* Renamed `traverseException` to `exception` and `traverseDynamic` to `dynamic`, upgrading them to use `Projection`.+* `makeClassy` now places each generated `Lens` or `Traversal` inside the class it constructs when possible.+ This makes it possible for users to just export `HasFoo(..)`, rather than have to enumerate each lens in+ the export list. It can only do that if it creates the class. If the `createClass` flag is disabled, then+ it will default to the old behavior.+* Added `performs` to `Control.Lens.Action` to mirror `views` in `Control.Lens.Getter`.+ 2.8 --- * Restored compatibility with GHC 7.2. This required a major version bump due to making some MPTC-based default signatures conditional.++2.7.0.1+-------+* Added the missing `Control.Lens.Combinators` to exported-modules! Its absence was causing it not to be included on hackage. 2.7 ---
README.markdown view
@@ -5,41 +5,84 @@ This package provides families of [lenses](https://github.com/ekmett/lens/blob/master/src/Control/Lens/Type.hs), [isomorphisms](https://github.com/ekmett/lens/blob/master/src/Control/Lens/Iso.hs), [folds](https://github.com/ekmett/lens/blob/master/src/Control/Lens/Fold.hs), [traversals](https://github.com/ekmett/lens/blob/master/src/Control/Lens/Traversal.hs), [getters](https://github.com/ekmett/lens/blob/master/src/Control/Lens/Getter.hs) and [setters](https://github.com/ekmett/lens/blob/master/src/Control/Lens/Setter.hs). -An overview of the [derivation](https://github.com/ekmett/lens/wiki/Derivation) of these types can be found on the [Lens Wiki](https://github.com/ekmett/lens/wiki) along with a brief [Tutorial](https://github.com/ekmett/lens/wiki/Tutorial).+An overview of the [derivation](https://github.com/ekmett/lens/wiki/Derivation) of these types can be found on the [Lens Wiki](https://github.com/ekmett/lens/wiki) along with a brief [Overview](https://github.com/ekmett/lens/wiki/Overview). -Documentation is available through [github](http://ekmett.github.com/lens) or [hackage](http://hackage.haskell.org/package/lens).+Documentation is available through [github](http://ekmett.github.com/lens/frames.html) or [hackage](http://hackage.haskell.org/package/lens). -Plated-------+Field Guide+----------- -New in version 2.5 is a port of the `Uniplate` API, updated to use `Traversal`. The Data-derived `biplate` and `uniplate` combinators run about 25% faster than the original `uniplate`, and you can use any of the other combinators, since `biplate` and `uniplate` are now just traversals.+[](https://creately.com/diagram/h5nyo9ne1/LBbRz63yg4yQsTXGLtub1bQU4%3D) Examples -------- -You can read from lenses (or other getters) and they compose in the order an imperative programmer would expect.+(See [`wiki/Examples`](https://github.com/ekmett/lens/wiki/Examples)) +First, import `Control.Lens`.+ ```haskell-ghci> :m + Control.Lens+ghci> import Control.Lens+```++Now, you can read from lenses++```haskell+ghci> ("hello","world")^._2+"world"+```++and you can write to lenses.++```haskell+ghci> set _2 42 ("hello","world")+("hello",42)+```++Composing lenses for reading (or writing) goes in the order an imperative programmer would expect, and just uses `(.)` from the `Prelude`.++```haskell ghci> ("hello",("world","!!!"))^._2._1 "world" ``` -You can make getters out of pure functions with `to`.+```haskell+ghci> set (_2._1) 42 ("hello","world")+("hello",(42,"!!!"))+``` +You can make a `Getter` out of a pure functions with `to`. ```haskell-ghci> ("hello",("world","!!!"))^._2._1.to length+ghci> "hello"^.to length 5 ``` -You can write to lenses and these writes can change the type of the container.+You can easily compose a `Getter` with a `Lens` just using `(.)`. No explicit coercion is necessary. ```haskell+ghci> ("hello",("world","!!!"))^._2._2.to length+3+```++As we saw above, you can write to lenses and these writes can change the type of the container. `(.~)` is an infix alias for `set`.++```haskell ghci> _1 .~ "hello" $ ((),"world") ("hello","world) ``` +Conversely `view`, can be used as an infix alias for `(^.)`.++```haskell+ghci> view _2 (10,20)+20+```++There are a large number of other lens variants provided by the library, in particular a `Traversal` generalizes `traverse` from `Data.Traversable`.++We'll come back to those later, but continuing with just lenses:+ You can let the library automatically derive lenses for fields of your data type ```haskell@@ -56,14 +99,45 @@ quux :: Lens (Foo a) (Foo b) a b ``` +A `Lens` takes 4 parameters because it can change the types of the whole when you change the type of the part.++Often you won't need this flexibility, a `Simple Lens` takes 2 parameters, and can be used directly as a `Lens`.+ You can also write to setters that target multiple parts of a structure, or their composition with other-lenses or setters.+lenses or setters. The canonical example of a setter is 'mapped': ```haskell+mapped :: Functor f => Setter (f a) (f b) a b+```++`over` is then analogous to `fmap`, but parameterized on the Setter.++```haskell+ghci> fmap succ [1,2,3]+[2,3,4]+ghci> over mapped succ [1,2,3]+[2,3,4]+```++The benefit is that you can use any `Lens` as a `Setter`, and the composition of setters with other setters or lenses using `(.)` yields+a `Setter`.++```haskell+ghci> over (mapped._2) succ [(1,2),(3,4)]+[(1,3),(3,5)]+```++`(%~)` is an infix alias for 'over', and the precedence lets you avoid swimming in parentheses:++```haskell ghci> _1.mapped._2.mapped %~ succ $ ([(42, "hello")],"world") ([(42, "ifmmp")],"world") ``` +There are a number of combinators that resemble the `+=`, `*=`, etc. operators from C/C++ for working with the monad transformers.++There are `+~`, `*~`, etc. analogues to those combinators that work functionally, returning the modified version of the structure.+ ```haskell ghci> both *~ 2 $ (1,2) (2,4)@@ -84,15 +158,16 @@ True ``` -You can also use this for generic programming:+You can also use this for generic programming. Combinators are included that are based on Neil Mitchell's `uniplate`, but which+have been generalized to work on or as lenses, folds, and traversals. ```haskell-ghci> :m + GHC.Generics.Lens-ghci> anyOf every (=="world") ("hello",(),[(2::Int,"world")])+ghci> :m + Data.Data.Lens+ghci> anyOf biplate (=="world") ("hello",(),[(2::Int,"world")]) True ``` -Anything you know how to do with a `Traversable` you can do with a `Traversal`.+As alluded to above, anything you know how to do with a `Traversable` you can do with a `Traversal`. ```haskell ghci> mapMOf (traverse._2) (\xs -> length xs <$ putStrLn xs) [(42,"hello"),(56,"world")]@@ -101,7 +176,7 @@ [(42,5),(56,5)] ``` -Many of the lenses supplied are isomorphisms, that means you can use them directly as a lens:+Moreover, many of the lenses supplied are actually isomorphisms, that means you can use them directly as a lens or getter: ```haskell ghci> let hello = "hello"^.packed@@ -110,7 +185,7 @@ hello :: Text ``` -but you can also flip them around and use them as a lens the other way with `from`+but you can also flip them around and use them as a lens the other way with `from`! ```haskell ghci> hello^.from packed.to length@@ -142,10 +217,200 @@ There is also a fully operational, but simple game of [Pong](https://github.com/ekmett/lens/blob/master/examples/Pong.hs) in the [examples/](https://github.com/ekmett/lens/blob/master/examples/) folder. -Field Guide------------+There are also a couple of hundred examples distributed throughout the haddock documentation. -[](https://creately.com/diagram/h5nyo9ne1/LBbRz63yg4yQsTXGLtub1bQU4%3D)+Operators+=========++(See [`wiki/Operators`](https://github.com/ekmett/lens/wiki/Operators))++<table>+<thead>+<tr>+ <th>Combinator(s)</th>+ <th>w/ Result</th>+ <th>Stateful</th>+ <th>w/ Result</th>+ <th>Notes</th>+</tr>+</thead>+<tbody>+<tr><th colspan=5><a href="http://ekmett.github.com/lens/Control-Lens.html">Control.Lens</a></th></tr>+<tr>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Getter.html#v:view"><code>view</code></a>,<a href="http://ekmett.github.com/lens/Control-Lens-Getter.html#v:views"><code>views</code></a>,<a href="http://ekmett.github.com/lens/Control-Lens-Getter.html#v:-94-."><code>^.</code></a></td>+ <td/>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Getter.html#v:use"><code>use</code></a>,<a href="http://ekmett.github.com/lens/Control-Lens-Getter.html#v:uses"><code>uses</code></a></td>+ <td/>+ <td>View target(s). <a href="http://ekmett.github.com/lens/Control-Lens-Getter.html#v:query"><code>query</code></a> works like <a href="http://ekmett.github.com/lens/Control-Lens-Getter.html#v:use"><code>use</code></a> over a <code>MonadReader</code></td>+</tr>+<tr>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:set"><code>set</code></a>, <a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:.-126-"><code>.~</code></a></td>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:-60-.-126-"><code><.~</code></a></td>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:.-61-"><code>.=</code></a></td>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:assign"><code>assign</code></a>,<a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:-60-.-61-"><code><.=</code></a></td>+ <td>Replace target(s). <a href="http://ekmett.github.com/lens/Control-Lens-Type.html#v:-60--60-.-126-"><code><<.~</code> and+ <a href="http://ekmett.github.com/lens/Control-Lens-Type.html#v:-60--60-.-61-"><code><<.=</code></a>+ return the old value</td>+</tr>+<tr>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:over"><code>over</code></a>,<a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:mapOf"><code>mapOf</code></a>,<a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:-37--126-"><code>%~</code></a></td>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Type.html#v:-60--37--126-"><code><%~</code></td>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:-37--61-"><code>%=</code></a></td>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Type.html#v:-60--37--61-"><code><%=</code></td>+ <td>Update target(s). <a href="http://ekmett.github.com/lens/Control-Lens-Type.html#v:-60--60--37--126-"><code><<%~</code> and+ <a href="http://ekmett.github.com/lens/Control-Lens-Type.html#v:-60--60--37--61-"><code><<%=</code></a>+ return the old value</td>+</tr>+<tr>+ <td><code>id</code>,<a href="http://ekmett.github.com/lens/Control-Lens-Traversal.html#v:traverseOf"><code>traverseOf</code></a>,<a href="http://ekmett.github.com/lens/Control-Lens-Type.html#v:-37--37--126-"><code>%%~</code></a></td>+ <td/>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Type.html#v:-37--37--61-"><code>%%=</code></a></td>+ <td/>+ <td>Update target(s) with an <code>Applicative</code> or auxillary result</td>+</tr>+<tr>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:-43--126-"><code>+~</code></a></td>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Type.html#v:-60--43--126-"><code><+~</code></td>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:-43--61-"><code>+=</code></a></td>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Type.html#v:-60--43--61-"><code><+=</code></td>+ <td>Add to target(s)</td>+</tr>+<tr>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:-45--126-"><code>-~</code></a></td>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Type.html#v:-60--45--126-"><code><-~</code></td>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:-45--61-"><code>-=</code></a></td>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Type.html#v:-60--45--61-"><code><-=</code></td>+ <td>Subtract from target(s)</td>+</tr>+<tr>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:-42--126-"><code>*~</code></a></td>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Type.html#v:-60--42--126-"><code><*~</code></td>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:-42--61-"><code>*=</code></a></td>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Type.html#v:-60--42--61-"><code><*=</code></td>+ <td>Multiply target(s)</td>+</tr>+<tr>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:-47--47--126-"><code>//~</code></a></td>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Type.html#v:-60--47--47--126-"><code><//~</code></td>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:-47--47--61-"><code>//=</code></a></td>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Type.html#v:-60--47--47--61-"><code><//=</code></td>+ <td>Divide target(s)</td>+</tr>+<tr>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:-94--126-"><code>^~</code></a></td>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Type.html#v:-60--94--126-"><code><^~</code></td>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:-94--61-"><code>^=</code></a></td>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Type.html#v:-60--94--61-"><code><^=</code></td>+ <td>Raise target(s) to a non-negative <code>Integral</code> power</td>+</tr>+<tr>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:-94--94--126-"><code>^^~</code></a></td>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Type.html#v:-60--94--94--126-"><code><^^~</code></td>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:-94--94--61-"><code>^^=</code></a></td>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Type.html#v:-60--94--94--61-"><code><^^=</code></td>+ <td>Raise target(s) to an <code>Integral</code> power</td>+</tr>+<tr>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:-42--42--126-"><code>**~</code></a></td>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Type.html#v:-60--42--42--126-"><code><**~</code></td>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:-42--42--61-"><code>**=</code></a></td>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Type.html#v:-60--42--42--61-"><code><**=</code></td>+ <td>Raise target(s) to an arbitrary power</td>+</tr>+<tr>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:-124--124--126-"><code>||~</code></a></td>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Type.html#v:-60--124--124--126-"><code><||~</code></td>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:-124--124--61-"><code>||=</code></a></td>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Type.html#v:-60--124--124--61-"><code><||=</code></td>+ <td>Logically or target(s)</td>+</tr>+<tr>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:-38--38--126-"><code>&&~</code></a></td>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Type.html#v:-60--38--38--126-"><code><&&~</code></td>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:-38--38--61-"><code>&&=</code></a></td>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Type.html#v:-60--38--38--61-"><code><&&=</code></td>+ <td>Logically and target(s)</td>+</tr>+<tr>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Fold.html#v:headOf"><code>headOf</code>,<a href="http://ekmett.github.com/lens/Control-Lens-Fold.html#v:-94--63-"><code>^?</code></a></td>+ <td/><td/><td/>+ <td>Return <code>Just</code> the first target or <code>Nothing</code></td>+</tr>+<tr>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Fold.html#v:toListOf"><code>toListOf</code>,<a href="http://ekmett.github.com/lens/Control-Lens-Fold.html#v:-94-.."><code>^..</code></a></td>+ <td/><td/><td/>+ <td>Return a list of the target(s)</td>+</tr>+<tr>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Action.html#v:perform"><code>perform</code></a>,<a href="http://ekmett.github.com/lens/Control-Lens-Action.html#v:performs"><code>performs</code></a><a href="http://ekmett.github.com/lens/Control-Lens-Action.html#v:-94-!"><code>^!</code></a></td>+ <td/>+ <td/>+ <td/>+ <td>Perform monadic action(s)</td>+</tr>+<tr><th colspan=5><a href="http://ekmett.github.com/lens/Control-Lens.html">Control.Lens</a> (Indexed)</th></tr>+<tr>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-IndexedSetter.html#v:iover"><code>iover</code></a>,<a href="http://ekmett.github.com/lens/Control-Lens-IndexedSetter.html#v:imapOf"><code>imapOf</code></a>,<a href="http://ekmett.github.com/lens/Control-Lens-IndexedSetter.html#v:-37--64--126-"><code>%@~</code></a></td>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-IndexedLens.html#v:-60--37--64--126-"><code><%@~</code></td>+ <td><a href=http://ekmett.github.com/lens/Control-Lens-IndexedSetter.html#v:-37--64--126-"><code>%@=</code></a></td>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-IndexedLens.html#v:-60--37--64--61-"><code><%@=</code></td>+ <td>Update target(s) with access to the index.</td>+</tr>+<tr>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-Indexed.html#v:withIndex"><code>withIndex</code></a>,<a href="http://ekmett.github.com/lens/Control-Lens-IndexedTraversal.html#v:itraverseOf"><code>itraverseOf</code></a>,<a href="http://ekmett.github.com/lens/Control-Lens-IndexedLens.html#v:-37--37--64--126-"><code>%%@~</code></a></td>+ <td/>+ <td><a href="http://ekmett.github.com/lens/Control-Lens-IndexedLens.html#v:-37--37--64--61-"><code>%%@=</code></a></td>+ <td/>+ <td>Update target(s) with an <code>Applicative</code> or auxillary result with access to the index.</td>+</tr>+<tr><th colspan=5><a href="http://ekmett.github.com/lens/Data-Bits-Lens.html">Data.Bits.Lens</a></th></tr>+<tr>+ <td><a href="http://ekmett.github.com/lens/Data-Bits-Lens.html#v:-124--126-"><code>|~</code></a></td>+ <td><a href="http://ekmett.github.com/lens/Data-Bits-Lens.html#v:-60--124--126-"><code><|~</code></td>+ <td><a href="http://ekmett.github.com/lens/Data-Bits-Lens.html#v:-124--61-"><code>|=</code></a></td>+ <td><a href="http://ekmett.github.com/lens/Data-Bits-Lens.html#v:-60--124--61-"><code><|=</code></td>+ <td>Bitwise or target(s)</td>+</tr>+<tr>+ <td><a href="http://ekmett.github.com/lens/Data-Bits-Lens.html#v:-38--126-"><code>&~</code></a></td>+ <td><a href="http://ekmett.github.com/lens/Data-Bits-Lens.html#v:-60--38--126-"><code><&~</code></td>+ <td><a href="http://ekmett.github.com/lens/Data-Bits-Lens.html#v:-38--61-"><code>&=</code></a></td>+ <td><a href="http://ekmett.github.com/lens/Data-Bits-Lens.html#v:-60--38--61-"><code><&=</code></td>+ <td>Bitwise and target(s)</td>+</tr>+<tr><th colspan=5><a href="http://ekmett.github.com/lens/Data-Monoid-Lens.html">Data.List.Lens</a></th></tr>+<tr>+ <td><a href="http://ekmett.github.com/lens/Data-List-Lens.html#v:-43--43--126-"><code>++~</code></a></td>+ <td><a href="http://ekmett.github.com/lens/Data-List-Lens.html#v:-60--43--43--126-"><code><++~</code></td>+ <td><a href="http://ekmett.github.com/lens/Data-List-Lens.html#v:-43--43--61-"><code>++=</code></a></td>+ <td><a href="http://ekmett.github.com/lens/Data-List-Lens.html#v:-60--43--43--61-"><code><++=</code></td>+ <td>Append to target list(s)</td>+</tr>+<tr><th colspan=5><a href="http://ekmett.github.com/lens/Data-Monoid-Lens.html">Data.Monoid.Lens</a></th></tr>+<tr>+ <td><a href="http://ekmett.github.com/lens/Data-Monoid-Lens.html#v:-60--62--126-"><code><>~</code></a></td>+ <td><a href="http://ekmett.github.com/lens/Data-Monoid-Lens.html#v:-60--60--62--126-"><code><<>~</code></td>+ <td><a href="http://ekmett.github.com/lens/Data-Monoid-Lens.html#v:-60--62--61-"><code><>=</code></a></td>+ <td><a href="http://ekmett.github.com/lens/Data-Monoid-Lens.html#v:-60--60--62--61-"><code><<>=</code></td>+ <td><code>mappend</code> to the target monoidal value(s)</td>+</tr>+<tr><th colspan=5><a href="http://ekmett.github.com/lens/System-FilePath-Lens.html">System.FilePath.Lens</a></th></tr>+<tr>+ <td><a href="http://ekmett.github.com/lens/System-FilePath-Lens.html#v:-60--47--62--126-"><code></>~</code></a></td>+ <td><a href="http://ekmett.github.com/lens/System-FilePath-Lens.html#v:-60--60--47--62--126-"><code><</>~</code></td>+ <td><a href="http://ekmett.github.com/lens/System-FilePath-Lens.html#v:-60--47--62--61-"><code></>=</code></a></td>+ <td><a href="http://ekmett.github.com/lens/System-FilePath-Lens.html#v:-60--60--47--62--61-"><code><</>=</code></td>+ <td>Append a relative path to a <code>FilePath</code></td>+</tr>+<tr>+ <td><a href="http://ekmett.github.com/lens/System-FilePath-Lens.html#v:-60-.-62--126-"><code><.>~</code></a></td>+ <td><a href="http://ekmett.github.com/lens/System-FilePath-Lens.html#v:-60--60-.-62--126-"><code><<.>~</code></td>+ <td><a href="http://ekmett.github.com/lens/System-FilePath-Lens.html#v:-60-.-62--61-"><code><.>=</code></a></td>+ <td><a href="http://ekmett.github.com/lens/System-FilePath-Lens.html#v:-60--60-.-62--61-"><code><<.>=</code></td>+ <td>Append a file extension to a <code>FilePath</code></td>+</tr>+</tbody>+</table> Contact Information -------------------
+ benchmarks/alongside.hs view
@@ -0,0 +1,109 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+import Control.Applicative+import Control.Comonad+import Control.Comonad.Store.Class+import Control.Lens.Internal+import Control.Lens+import Criterion.Main+import Data.Functor.Compose+import Data.Functor.Identity++-- | A finally encoded Store+newtype Experiment c d a = Experiment { runExperiment :: forall f. Functor f => (c -> f d) -> f a }++instance Functor (Experiment c d) where+ fmap f (Experiment k) = Experiment (fmap f . k)+ {-# INLINE fmap #-}++instance (c ~ d) => Comonad (Experiment c d) where+ extract (Experiment m) = runIdentity (m Identity)+ {-# INLINE extract #-}+ duplicate = duplicateExperiment+ {-# INLINE duplicate #-}++-- | 'Experiment' is an indexed 'Comonad'.+duplicateExperiment :: Experiment c e a -> Experiment c d (Experiment d e a)+duplicateExperiment (Experiment m) = getCompose (m (Compose . fmap placebo . placebo))+{-# INLINE duplicateExperiment #-}++-- | A trivial 'Experiment'.+placebo :: c -> Experiment c d d+placebo i = Experiment (\k -> k i)+{-# INLINE placebo #-}++instance (c ~ d) => ComonadStore c (Experiment c d) where+ pos m = posExperiment m+ peek d m = peekExperiment d m+ peeks f m = runIdentity $ runExperiment m (\c -> Identity (f c))+ experiment f m = runExperiment m f++posExperiment :: Experiment c d a -> c+posExperiment m = getConst (runExperiment m Const)+{-# INLINE posExperiment #-}++peekExperiment :: d -> Experiment c d a -> a+peekExperiment d m = runIdentity $ runExperiment m (\_ -> Identity d)+{-# INLINE peekExperiment #-}++trial :: Lens a b c d -> Lens a' b' c' d' -> Lens (a,a') (b,b') (c,c') (d,d')+trial l r pfq (a,a') = fmap (\(d,b') -> (peekExperiment d x,b')) (getCompose (r (\c' -> Compose $ pfq (posExperiment x, c')) a'))+ where x = l placebo a+{-# INLINE trial #-}++posContext :: Context c d a -> c+posContext (Context _ c) = c+{-# INLINE posContext #-}++peekContext :: d -> Context c d a -> a+peekContext d (Context f _) = f d+{-# INLINE peekContext #-}++-- a version of alongside built with Context and product+half :: LensLike (Context c d) a b c d -> Lens a' b' c' d' -> Lens (a,a') (b,b') (c,c') (d,d')+half l r pfq (a,a') = fmap (\(d,b') -> (peekContext d x,b')) (getCompose (r (\c' -> Compose $ pfq (posContext x, c')) a'))+ where x = l (Context id) a+{-# INLINE half #-}++-- alongside' :: Lens a b c d -> Lens a' b' c' d' -> Lens (a,a') (b,b') (c,c') (d,d')+-- {-# INLINE alongside'#-}++compound :: Lens a b c d+ -> Lens a' b' c' d'+ -> Lens (a,a') (b,b') (c,c') (d,d')+compound l r = lens (\(a, a') -> (view l a, view r a'))+ (\(a, a') (b, b') -> (set l b a, set r b' a'))+{-# INLINE compound #-}++compound5 :: Lens a b c d+ -> Lens a' b' c' d'+ -> Lens a'' b'' c'' d''+ -> Lens a''' b''' c''' d'''+ -> Lens a'''' b'''' c'''' d''''+ -> Lens (a, (a', (a'', (a''', a''''))))+ (b, (b', (b'', (b''', b''''))))+ (c, (c', (c'', (c''', c''''))))+ (d, (d', (d'', (d''', d''''))))+compound5 l l' l'' l''' l''''+ = lens (\(a, (a', (a'', (a''', a''''))))+ -> (view l a, (view l' a', (view l'' a'', (view l''' a''', view l'''' a'''')))) )+ (\(a, (a', (a'', (a''', a'''')))) (b, (b', (b'', (b''', b''''))))+ -> (set l b a, (set l' b' a', (set l'' b'' a'', (set l''' b''' a''', set l'''' b'''' a'''')))) )++main = defaultMain+ [ bench "alongside1" $ nf (view $ alongside _1 _2) (("hi", 1), (2, "there!"))+ , bench "trial1" $ nf (view $ trial _1 _2) (("hi", 1), (2, "there!"))+ , bench "half1" $ nf (view $ half _1 _2) (("hi", 1), (2, "there!"))+ , bench "compound1" $ nf (view $ compound _1 _2) (("hi", 1), (2, "there!"))+ , bench "alongside5" $ nf (view $ (alongside _1 (alongside _1 (alongside _1 (alongside _1 _1)))))+ ((v,v),((v,v),((v,v),((v,v),(v,v)))))+ , bench "trial5" $ nf (view $ (trial _1 (trial _1 (trial _1 (trial _1 _1)))))+ ((v,v),((v,v),((v,v),((v,v),(v,v)))))+ , bench "half5" $ nf (view $ (half _1 (half _1 (half _1 (half _1 _1)))))+ ((v,v),((v,v),((v,v),((v,v),(v,v)))))+ , bench "compound5" $ nf (view $ compound5 _1 _1 _1 _1 _1)+ ((v,v),((v,v),((v,v),((v,v),(v,v)))))+ ]+ where v = 1 :: Int
+ examples/Aeson.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE Rank2Types #-}+-- |+-- This is a small example of how to construct a projection for a third-party library like+-- @aeson@.+--+-- To test this:+--+-- > doctest Aeson.hs+module Aeson where++import Control.Lens+import Data.Aeson+import Data.ByteString.Lazy++-- |+-- >>> 5^.by aeson+-- "5"+-- >>> [1,2,3]^.by aeson+-- "[1,2,3]"+-- >>> aeson.both +~ 2 $ (2,3)^.by aeson+-- "[4,5]"+aeson, aeson' :: (FromJSON c, ToJSON d) => Projection ByteString ByteString c d+aeson = projection encode decode+aeson' = projection encode decode'
lens.cabal view
@@ -1,6 +1,6 @@ name: lens category: Data, Lenses-version: 2.8+version: 2.9 license: BSD3 cabal-version: >= 1.8 license-file: LICENSE@@ -37,7 +37,7 @@ . The core of this hierarchy looks like: .- <<https://github.com/ekmett/lens/wiki/images/Hierarchy-2.8.png>>+ <<https://github.com/ekmett/lens/wiki/images/Hierarchy-2.9.png>> . You can compose any two elements of the hierarchy above using (.) from the Prelude, and you can use any element of the hierarchy as any type it links to above it.@@ -93,6 +93,7 @@ examples/lens-examples.cabal examples/Pong.hs examples/Plates.hs+ examples/Aeson.hs README.markdown CHANGELOG.markdown @@ -132,6 +133,11 @@ default: False manual: True +-- Make the test suites dump their template-haskell splices.+flag dump-splices+ default: False+ manual: True+ library build-depends: base >= 4.4 && < 5,@@ -163,6 +169,7 @@ Control.Lens.Iso Control.Lens.Isomorphic Control.Lens.Plated+ Control.Lens.Projection Control.Lens.Representable Control.Lens.Setter Control.Lens.Traversal@@ -220,20 +227,6 @@ ghc-options: -Wall -fwarn-tabs -O2 -fdicts-cheap -funbox-strict-fields hs-source-dirs: src --- Verify the results of the examples-test-suite doctests- type: exitcode-stdio-1.0- main-is: doctests.hs- build-depends:- base,- directory >= 1.0 && < 1.3,- doctest >= 0.8 && <= 0.9,- filepath- ghc-options: -Wall -threaded- if impl(ghc<7.6.1)- ghc-options: -Werror- hs-source-dirs: tests- -- Verify that Template Haskell expansion works test-suite templates type: exitcode-stdio-1.0@@ -242,6 +235,8 @@ base, lens ghc-options: -Wall -threaded+ if flag(dump-splices)+ ghc-options: -ddump-splices if impl(ghc<7.6.1) ghc-options: -Werror hs-source-dirs: tests@@ -273,6 +268,20 @@ ghc-options: -w -threaded hs-source-dirs: tests +-- Verify the results of the examples+test-suite doctests+ type: exitcode-stdio-1.0+ main-is: doctests.hs+ build-depends:+ base,+ directory >= 1.0 && < 1.3,+ doctest >= 0.9 && <= 0.10,+ filepath+ ghc-options: -Wall -threaded+ if impl(ghc<7.6.1)+ ghc-options: -Werror+ hs-source-dirs: tests+ -- Basic benchmarks for the uniplate-style combinators benchmark plated type: exitcode-stdio-1.0@@ -285,8 +294,24 @@ ghc-prim, lens, transformers- ghc-options: -Wall -O2 -threaded+ ghc-options: -Wall -O2 -threaded -fdicts-cheap -funbox-strict-fields hs-source-dirs: benchmarks if flag(benchmark-uniplate) build-depends: uniplate >= 1.6.7 && < 1.7 cpp-options: -DBENCHMARK_UNIPLATE++-- Basic benchmarks for the uniplate-style combinators+benchmark alongside+ type: exitcode-stdio-1.0+ main-is: alongside.hs+ build-depends:+ base,+ comonad,+ comonads-fd,+ criterion,+ deepseq,+ ghc-prim,+ lens,+ transformers+ ghc-options: -w -O2 -threaded -fdicts-cheap -funbox-strict-fields+ hs-source-dirs: benchmarks
src/Control/Exception/Lens.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE FlexibleContexts #-} ----------------------------------------------------------------------------- -- | -- Module : Control.Exception.Lens@@ -9,10 +10,9 @@ -- ---------------------------------------------------------------------------- module Control.Exception.Lens- ( traverseException+ ( exception ) where -import Control.Applicative import Control.Exception import Control.Lens @@ -21,11 +21,9 @@ -- the desired 'Exception'. -- -- @--- traverseException :: ('Applicative' f, 'Exception' a, 'Exception' b)--- => (a -> f b) -> 'SomeException' -> f 'SomeException'+-- exception :: ('Applicative' f, 'Exception' a, 'Exception' b)+-- => (a -> f b) -> 'SomeException' -> f 'SomeException' -- @-traverseException :: (Exception a, Exception b) => Traversal SomeException SomeException a b-traverseException f e = case fromException e of- Just a -> toException <$> f a- Nothing -> pure e-{-# INLINE traverseException #-}+exception :: (Exception a, Exception b) => Projection SomeException SomeException a b+exception = projection SomeException fromException+{-# INLINE exception #-}
src/Control/Lens.hs view
@@ -41,7 +41,7 @@ -- -- <http://github.com/ekmett/lens/wiki> ----- <<http://github.com/ekmett/lens/wiki/images/Hierarchy-2.8.png>>+-- <<http://github.com/ekmett/lens/wiki/images/Hierarchy-2.9.png>> ---------------------------------------------------------------------------- module Control.Lens ( module Control.Lens.Type@@ -59,6 +59,7 @@ , module Control.Lens.IndexedTraversal , module Control.Lens.IndexedSetter , module Control.Lens.Plated+ , module Control.Lens.Projection , module Control.Lens.Representable #ifndef DISABLE_TEMPLATE_HASKELL , module Control.Lens.TH@@ -80,6 +81,7 @@ import Control.Lens.IndexedTraversal import Control.Lens.Iso import Control.Lens.Plated+import Control.Lens.Projection import Control.Lens.Representable import Control.Lens.Setter #ifndef DISABLE_TEMPLATE_HASKELL
src/Control/Lens/Action.hs view
@@ -17,6 +17,7 @@ , act , acts , perform+ , performs , liftAct , (^!) @@ -31,6 +32,9 @@ import Control.Lens.Internal import Control.Monad.Trans.Class +-- $setup+-- >>> import Control.Lens+ infixr 8 ^! -- | An 'Action' is a 'Getter' enriched with access to a 'Monad' for side-effects.@@ -57,9 +61,12 @@ perform l = getEffect . l (Effect . return) {-# INLINE perform #-} +-- | Perform an 'Action' and modify the result.+performs :: Monad m => Acting m e a b c d -> (c -> e) -> a -> m e+performs l f = getEffect . l (Effect . return . f)+ -- | Perform an 'Action' ----- >>> import Control.Lens -- >>> ["hello","world"]^!folded.act putStrLn -- hello -- world@@ -76,7 +83,6 @@ -- -- @'acts' = 'act' 'id'@ ----- >>> import Control.Lens -- >>> (1,"hello")^!_2.acts.to succ -- "ifmmp" acts :: Action m (m a) a
src/Control/Lens/Combinators.hs view
@@ -9,24 +9,10 @@ -- ------------------------------------------------------------------------------- module Control.Lens.Combinators- ( (|>)- , (<$!>), (<$!)+ ( (<$!>), (<$!) ) where infixr 4 <$!>, <$!-infixl 1 |>---- | Passes the result of the left side to the function on the right side (forward pipe operator).------ This is the flipped version of ('$'), which is more common in languages like F# where it is needed--- for inference. Here it is supplied for notational convenience and given a precedence that allows it--- to be nested inside uses of ('$').------ >>> "hello" |> length |> succ--- 6-(|>) :: a -> (a -> b) -> b-a |> f = f a-{-# INLINE (|>) #-} -- | A strict version of ('Data.Functor.<$>') for monads. --
src/Control/Lens/Fold.hs view
@@ -86,6 +86,9 @@ import Data.Maybe import Data.Monoid +-- $setup+-- >>> import Control.Lens+ infixl 8 ^?, ^.. --------------------------@@ -138,7 +141,6 @@ -- | Transform a fold into a fold that loops over its elements over and over. ----- >>> import Control.Lens -- >>> take 6 $ toListOf (cycled traverse) [1,2,3] -- [1,2,3,1,2,3] cycled :: (Applicative f, Gettable f) => LensLike f a b c d -> LensLike f a b c d@@ -279,7 +281,6 @@ -- ('^..') ≡ 'flip' 'toListOf' -- @ --- >>> import Control.Lens -- >>> toListOf both ("hello","world") -- ["hello","world"] --@@ -298,7 +299,6 @@ -- -- A convenient infix (flipped) version of 'toListOf'. ----- >>> import Control.Lens -- >>> [[1,2],[3]]^..traverse.traverse -- [1,2,3] --@@ -322,7 +322,6 @@ -- | Returns 'True' if every target of a 'Fold' is 'True'. ----- >>> import Control.Lens -- >>> andOf both (True,False) -- False -- >>> andOf both (True,True)@@ -343,7 +342,6 @@ -- | Returns 'True' if any target of a 'Fold' is 'True'. ----- >>> import Control.Lens -- >>> orOf both (True,False) -- True -- >>> orOf both (False,False)@@ -364,7 +362,6 @@ -- | Returns 'True' if any target of a 'Fold' satisfies a predicate. ----- >>> import Control.Lens -- >>> anyOf both (=='x') ('x','y') -- True -- >>> import Data.Data.Lens@@ -386,7 +383,6 @@ -- | Returns 'True' if every target of a 'Fold' satisfies a predicate. ----- >>> import Control.Lens -- >>> allOf both (>=3) (4,5) -- True -- >>> allOf folded (>=2) [1..10]@@ -407,7 +403,6 @@ -- | Calculate the product of every number targeted by a 'Fold' ----- >>> import Control.Lens -- >>> productOf both (4,5) -- 20 -- >>> productOf folded [1,2,3,4,5]@@ -428,7 +423,6 @@ -- | Calculate the sum of every number targeted by a 'Fold'. ----- >>> import Control.Lens -- >>> sumOf both (5,6) -- 11 -- >>> sumOf folded [1,2,3,4]@@ -464,7 +458,6 @@ -- When passed a 'Getter', 'traverseOf_' can work over any 'Functor', but when passed a 'Fold', 'traverseOf_' requires -- an 'Applicative'. ----- >>> import Control.Lens -- >>> traverseOf_ both putStrLn ("hello","world") -- hello -- world@@ -607,7 +600,6 @@ -- | Does the element occur anywhere within a given 'Fold' of the structure? ----- >>> import Control.Lens -- >>> elemOf both "hello" ("hello","world") -- True --@@ -656,7 +648,6 @@ -- | Concatenate all of the lists targeted by a 'Fold' into a longer list. ----- >>> import Control.Lens -- >>> concatOf both ("pan","ama") -- "panama" --@@ -681,7 +672,6 @@ -- -- @'length' ≡ 'lengthOf' 'folded'@ ----- >>> import Control.Lens -- >>> lengthOf _1 ("hello",()) -- 1 --@@ -756,7 +746,6 @@ -- -- This may be rather inefficient compared to the 'null' check of many containers. ----- >>> import Control.Lens -- >>> nullOf _1 (1,2) -- False --
src/Control/Lens/Getter.hs view
@@ -47,6 +47,7 @@ , to -- * Combinators for Getters and Folds , (^.), (^$)+ , (%), (^%) , view , views , use@@ -56,16 +57,48 @@ -- * Storing Getters , ReifiedGetter(..)+ , Gettable+ , Accessor ) where import Control.Lens.Internal import Control.Monad.Reader.Class as Reader import Control.Monad.State.Class as State -infixl 8 ^.+-- $setup+-- >>> import Control.Lens++infixl 8 ^., ^%+infixl 1 % infixr 0 ^$ -------------------------------------------------------------------------------+-- Pipelining+-------------------------------------------------------------------------------++-- | Passes the result of the left side to the function on the right side (forward pipe operator).+--+-- This is the flipped version of ('$'), which is more common in languages like F# as (@|>@) where it is needed+-- for inference. Here it is supplied for notational convenience and given a precedence that allows it+-- to be nested inside uses of ('$').+--+-- >>> "hello" % length % succ+-- 6+(%) :: a -> (a -> b) -> b+a % f = f a+{-# INLINE (%) #-}++-- | A version of ('Control.Lens.Combinators.%') with much tighter precedence that can be interleaved with ('^.')+--+-- >>> "hello"^%length+-- 5+-- >>> import Data.List.Lens+-- >>> ("hello","world")^._1^%reverse^._head+-- 'o'+(^%) :: a -> (a -> b) -> b+a ^% f = f a++------------------------------------------------------------------------------- -- Getters ------------------------------------------------------------------------------- @@ -86,7 +119,6 @@ -- -- @a '^.' 'to' f = f a@ ----- >>> import Control.Lens -- -- >>> ("hello","world")^.to snd -- "world"@@ -100,6 +132,7 @@ to f g = coerce . g . f {-# INLINE to #-} + -- | -- Most 'Getter' combinators are able to be used with both a 'Getter' or a -- 'Control.Lens.Fold.Fold' in limited situations, to do so, they need to be@@ -125,7 +158,6 @@ -- -- @'view' . 'to' = 'id'@ ----- >>> import Control.Lens -- >>> view _2 (1,"hello") -- "hello" --@@ -160,7 +192,6 @@ -- -- @'views' l f = 'view' (l '.' 'to' f)@ ----- >>> import Control.Lens -- >>> views _2 length (1,"hello") -- 5 --@@ -184,7 +215,6 @@ -- -- @'to' f '^$' x = f x@ ----- >>> import Control.Lens -- >>> _2 ^$ (1, "hello") -- "hello" --@@ -208,7 +238,6 @@ -- The fixity and semantics are such that subsequent field accesses can be -- performed with ('Prelude..') ----- >>> import Control.Lens -- >>> ("hello","world")^._2 -- "world" --
src/Control/Lens/IndexedLens.hs view
@@ -52,6 +52,9 @@ import Data.IntSet as IntSet import Data.Set as Set +-- $setup+-- >>> import Control.Lens+ infixr 4 %%@~, <%@~ infix 4 %%@=, <%@= @@ -137,7 +140,6 @@ -- | Provides an 'IndexedLens' that can be used to read, write or delete the value associated with a key in a map-like container. class At k m | m -> k where -- |- -- >>> import Control.Lens -- >>> Map.fromList [(1,"hello")] ^.at 1 -- Just "hello" --@@ -166,7 +168,6 @@ -- | Provides an 'IndexedLens' that can be used to read, write or delete a member of a set-like container class Contains k m | m -> k where -- |- -- >>> :m + Control.Lens -- >>> contains 3 .~ False $ IntSet.fromList [1,2,3,4] -- fromList [1,2,4] contains :: k -> SimpleIndexedLens k m Bool
src/Control/Lens/IndexedTraversal.hs view
@@ -57,6 +57,9 @@ import Data.IntMap as IntMap import Data.Map as Map +-- $setup+-- >>> import Control.Lens+ ------------------------------------------------------------------------------ -- Indexed Traversals ------------------------------------------------------------------------------@@ -176,7 +179,6 @@ -- | Access the element of an 'IndexedTraversal' where the index matches a predicate. ----- >>> :m + Control.Lens -- >>> over (iwhereOf (indexed traverse) (>0)) reverse $ ["He","was","stressed","o_O"] -- ["He","saw","desserts","O_o"] --
src/Control/Lens/Iso.hs view
@@ -43,6 +43,9 @@ import Data.Functor.Identity import Prelude hiding ((.),id) +-- $setup+-- >>> import Control.Lens+ ----------------------------------------------------------------------------- -- Isomorphisms families as Lenses -----------------------------------------------------------------------------@@ -52,14 +55,16 @@ -- with each other using ('.') from the Prelude, they will be dumbed down to a -- mere 'Lens'. ----- > import Control.Category--- > import Prelude hiding ((.),id)+-- @+-- import Control.Category+-- import Prelude hiding (('Prelude..'),'Prelude.id')+-- @ ----- @type Iso a b c d = forall k f. ('Isomorphic' k, 'Functor' f) => 'Overloaded' k f a b c d@+-- @type 'Iso' a b c d = forall k f. ('Isomorphic' k, 'Functor' f) => 'Overloaded' k f a b c d@ type Iso a b c d = forall k f. (Isomorphic k, Functor f) => k (c -> f d) (a -> f b) -- |--- @type SimpleIso = 'Control.Lens.Type.Simple' 'Iso'@+-- @type 'SimpleIso' = 'Control.Lens.Type.Simple' 'Iso'@ type SimpleIso a b = Iso a a b b -- | Build an isomorphism family from two pairs of inverse functions@@ -95,7 +100,7 @@ -- | Based on @ala@ from Conor McBride's work on Epigram. ----- >>> :m + Control.Lens Data.Monoid.Lens Data.Foldable+-- >>> :m + Data.Monoid.Lens Data.Foldable -- >>> ala _sum foldMap [1,2,3,4] -- 10 ala :: Simple Iso a b -> ((a -> b) -> c -> b) -> c -> a@@ -106,7 +111,7 @@ -- Based on @ala'@ from Conor McBride's work on Epigram. -- -- Mnemonically, the German /auf/ plays a similar role to /à la/, and the combinator--- is /au/ with an extra function argument.+-- is 'ala' with an extra function argument. auf :: Simple Iso a b -> ((d -> b) -> c -> b) -> (d -> a) -> c -> a auf l f g e = f (view l . g) e ^. from l {-# INLINE auf #-}@@ -115,7 +120,7 @@ -- -- @'under' = 'over' '.' 'from'@ ----- @'under' :: Iso a b c d -> (a -> b) -> (c -> d)@+-- @'under' :: 'Iso' a b c d -> (a -> b) -> c -> d@ under :: Isomorphism (c -> Mutator d) (a -> Mutator b) -> (a -> b) -> c -> d under = over . from {-# INLINE under #-}@@ -151,5 +156,5 @@ -- | Useful for storing isomorphisms in containers. newtype ReifiedIso a b c d = ReifyIso { reflectIso :: Iso a b c d } --- | @type SimpleReifiedIso = 'Control.Lens.Type.Simple' 'ReifiedIso'@+-- | @type 'SimpleReifiedIso' = 'Control.Lens.Type.Simple' 'ReifiedIso'@ type SimpleReifiedIso a b = ReifiedIso a a b b
+ src/Control/Lens/Projection.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+-------------------------------------------------------------------------------+-- |+-- Module : Control.Lens.Projection+-- Copyright : (C) 2012 Edward Kmett+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Edward Kmett <ekmett@gmail.com>+-- Stability : provisional+-- Portability : non-portable+--+-------------------------------------------------------------------------------+module Control.Lens.Projection+ ( Projection+ , Projective(..)+ , project+ , by+ , Project(..)+ , projection+ , stereo+ , mirror+ -- * Simple+ , SimpleProjection+ ) where++import Control.Applicative+import Control.Lens.Type+import Control.Lens.Getter+import Data.Functor.Identity+import Control.Lens.Iso++-- | A 'Projection' is a 'Traversal' that can also be turned around with 'by' to obtain a 'Getter'+type Projection a b c d = forall k f. (Projective k a d, Applicative f) => k (c -> f d) (a -> f a)++-- | Used to provide overloading of projections.+class Projective k a d where+ projective :: (d -> a) -> (x -> y) -> k x y++instance Projective (->) a d where+ projective _ x = x++-- | A concrete 'Projection', suitable for storing in a container or extracting an embedding.+data Project a d x y = Project (d -> a) (x -> y)++-- | Compose projections.+stereo :: Projective k a c => Project b c y z -> Project a b x y -> k x z+stereo (Project g f) (Project i h) = projective (i.g) (f.h)++instance (a ~ a', d ~ d') => Projective (Project a d) a' d' where+ projective = Project++-- | Reflect a 'Projection'.+project :: Projective k a d => Overloaded (Project a d) f a a c d -> Overloaded k f a a c d+project (Project f g) = projective f g++-- | Turn a 'Projection' around to get an embedding+by :: Project a d (d -> Identity d) (a -> Identity a) -> Getter d a+by (Project g _) = to g++-- | Build a 'Projection'+projection :: (d -> a) -> (a -> Maybe c) -> Projection a b c d+projection da amc = projective da (\cfd a -> maybe (pure a) (fmap da . cfd) (amc a))++-- | Convert an 'Iso' to a 'Projection'.+--+-- Ideally we would be able to use an 'Iso' directly as a 'Projection', but this opens a can of worms.+mirror :: Projective k a c => Simple Iso a c -> Simple Projection a c+mirror l = projection (^.from l) (\a -> Just (a^.l))++-- | @type 'SimpleProjection' = 'Simple' 'Projection'@+type SimpleProjection a b = Projection a a b b
src/Control/Lens/Setter.hs view
@@ -48,12 +48,18 @@ -- * Simplicity , SimpleSetter , SimpleReifiedSetter+ -- * Exported for legible error messages+ , Settable+ , Mutator ) where import Control.Applicative import Control.Lens.Internal import Control.Monad.State.Class as State +-- $setup+-- >>> import Control.Lens+ infixr 4 .~, +~, *~, -~, //~, ^~, ^^~, **~, &&~, ||~, %~, <.~ infix 4 .=, +=, *=, -=, //=, ^=, ^^=, **=, &&=, ||=, %=, <.= infixr 2 <~@@ -127,7 +133,6 @@ -- ('<$') ≡ 'set' 'mapped' -- @ ----- >>> import Control.Lens -- >>> over mapped (+1) [1,2,3] -- [2,3,4] --@@ -179,7 +184,6 @@ -- 'over' '.' 'sets' ≡ 'id' -- @ ----- >>> import Control.Lens -- >>> over mapped (*10) [1,2,3] -- [10,20,30] --@@ -205,7 +209,6 @@ -- 'mapOf' '.' 'sets' ≡ 'id' -- @ ----- >>> import Control.Lens -- >>> mapOf mapped (+1) [1,2,3,4] -- [2,3,4,5] --@@ -230,7 +233,6 @@ -- -- @('<$') ≡ 'set' 'mapped'@ ----- >>> import Control.Lens -- >>> set _2 "hello" (1,()) -- (1,"hello") --@@ -260,7 +262,6 @@ -- 'Data.Traversable.fmapDefault' f ≡ 'traverse' '%~' f -- @ ----- >>> import Control.Lens -- >>> _2 %~ length $ (1,"hello") -- (1,5) --@@ -290,7 +291,6 @@ -- -- @f '<$' a ≡ 'mapped' '.~' f '$' a@ ----- >>> import Control.Lens -- >>> _1 .~ "hello" $ (42,"world") -- ("hello","world") --@@ -310,7 +310,6 @@ -- -- If you do not need a copy of the intermediate result, then using @l '.~' d@ directly is a good idea. ----- >>> import Control.Lens -- >>> _3 <.~ "world" $ ("good","morning","vietnam") -- ("world",("good","morning","world")) --@@ -330,7 +329,6 @@ -- | Increment the target(s) of a numerically valued 'Control.Lens.Type.Lens', 'Setter' or 'Control.Lens.Traversal.Traversal' ----- >>> import Control.Lens -- >>> _1 +~ 1 $ (1,2) -- (2,2) --@@ -349,7 +347,6 @@ -- | Multiply the target(s) of a numerically valued 'Control.Lens.Type.Lens', 'Control.Lens.Iso.Iso', 'Setter' or 'Control.Lens.Traversal.Traversal' ----- >>> import Control.Lens -- >>> _2 *~ 4 $ (1,2) -- (1,8) --@@ -368,7 +365,6 @@ -- | Decrement the target(s) of a numerically valued 'Control.Lens.Type.Lens', 'Control.Lens.Iso.Iso', 'Setter' or 'Control.Lens.Traversal.Traversal' ----- >>> import Control.Lens -- >>> _1 -~ 2 $ (1,2) -- (-1,2) --@@ -387,7 +383,6 @@ -- | Divide the target(s) of a numerically valued 'Control.Lens.Type.Lens', 'Control.Lens.Iso.Iso', 'Setter' or 'Control.Lens.Traversal.Traversal' ----- >>> import Control.Lens -- >>> _2 //~ 2 $ ("Hawaii",10) -- ("Hawaii",5.0) --@@ -402,7 +397,6 @@ -- | Raise the target(s) of a numerically valued 'Control.Lens.Type.Lens', 'Setter' or 'Control.Lens.Traversal.Traversal' to a non-negative integral power ----- >>> import Control.Lens -- >>> _2 ^~ 2 $ (1,3) -- (1,9) --@@ -418,7 +412,6 @@ -- | Raise the target(s) of a fractionally valued 'Control.Lens.Type.Lens', 'Setter' or 'Control.Lens.Traversal.Traversal' to an integral power ----- >>> import Control.Lens -- >>> _2 ^^~ (-1) $ (1,2) -- (1,0.5) --@@ -435,7 +428,6 @@ -- | Raise the target(s) of a floating-point valued 'Control.Lens.Type.Lens', 'Setter' or 'Control.Lens.Traversal.Traversal' to an arbitrary power. ----- >>> import Control.Lens -- >>> _2 **~ pi $ (1,3) -- (1,31.54428070019754) --@@ -451,7 +443,6 @@ -- | Logically '||' the target(s) of a 'Bool'-valued 'Control.Lens.Type.Lens' or 'Setter' ----- >>> import Control.Lens -- >>> both ||~ True $ (False,True) -- (True,True) --@@ -470,7 +461,6 @@ -- | Logically '&&' the target(s) of a 'Bool'-valued 'Control.Lens.Type.Lens' or 'Setter' ----- >>> import Control.Lens -- >>> both &&~ True $ (False, True) -- (False,True) --@@ -706,3 +696,4 @@ -- | @type 'SimpleReifiedSetter' = 'Control.Lens.Type.Simple' 'ReifiedSetter'@ type SimpleReifiedSetter a b = ReifiedSetter a a b b+
src/Control/Lens/TH.hs view
@@ -48,7 +48,6 @@ import Control.Lens.Traversal import Control.Lens.Type import Control.Lens.IndexedLens-import Control.Lens.Combinators import Control.Monad import Data.Char (toLower) import Data.Either (lefts)@@ -169,21 +168,21 @@ -- for isomorphisms and traversals, and not making any classes. lensRules :: LensRules lensRules = defaultRules- |> lensIso .~ const Nothing- |> lensClass .~ const Nothing- |> handleSingletons .~ True- |> partialLenses .~ False- |> buildTraversals .~ True+ % lensIso .~ const Nothing+ % lensClass .~ const Nothing+ % handleSingletons .~ True+ % partialLenses .~ False+ % buildTraversals .~ True -- | Rules for making lenses and traversals that precompose another lens. classyRules :: LensRules classyRules = defaultRules- |> lensIso .~ const Nothing- |> handleSingletons .~ False- |> lensClass .~ classy- |> classRequired .~ True- |> partialLenses .~ False- |> buildTraversals .~ True+ % lensIso .~ const Nothing+ % handleSingletons .~ False+ % lensClass .~ classy+ % classRequired .~ True+ % partialLenses .~ False+ % buildTraversals .~ True where classy :: String -> Maybe (String, String) classy n@(a:as) = Just ("Has" ++ n, toLower a:as)@@ -192,8 +191,8 @@ -- | Rules for making an isomorphism from a data type isoRules :: LensRules isoRules = defaultRules- |> singletonRequired .~ True- |> singletonAndField .~ True+ % singletonRequired .~ True+ % singletonAndField .~ True -- | Build lenses (and traversals) with a sensible default configuration. --@@ -253,7 +252,7 @@ -- > makeLensesFor [("_foo", "fooLens"), ("baz", "lbaz")] ''Foo -- > makeLensesFor [("_barX", "bar"), ("_barY", "bar)] ''Bar makeLensesFor :: [(String, String)] -> Name -> Q [Dec]-makeLensesFor fields = makeLensesWith $ lensRules |> lensField .~ (`Prelude.lookup` fields)+makeLensesFor fields = makeLensesWith $ lensRules % lensField .~ (`Prelude.lookup` fields) -- | Derive lenses and traversals, using a named wrapper class, and specifying -- explicit pairings of @(fieldName, traversalName)@.@@ -263,8 +262,8 @@ -- > makeClassyFor "HasFoo" "foo" [("_foo", "fooLens"), ("bar", "lbar")] ''Foo makeClassyFor :: String -> String -> [(String, String)] -> Name -> Q [Dec] makeClassyFor clsName funName fields = makeLensesWith $ classyRules- |> lensClass .~ const (Just (clsName,funName))- |> lensField .~ (`Prelude.lookup` fields)+ % lensClass .~ const (Just (clsName,funName))+ % lensField .~ (`Prelude.lookup` fields) -- | Build lenses with a custom configuration. makeLensesWith :: LensRules -> Name -> Q [Dec]@@ -448,25 +447,9 @@ guard $ tyArgs == [] view lensClass cfg $ nameBase tyConName maybeClassName = fmap (^._1.to mkName) maybeLensClass- classDecls <- case maybeLensClass of- Nothing -> return []- Just (clsNameString, methodNameString) -> do- let clsName = mkName clsNameString- methodName = mkName methodNameString- t <- newName "t"- a <- newName "a"- Prelude.sequence $- filter (\_ -> cfg^.createClass)- [ classD (return []) clsName [PlainTV t] []- [ sigD methodName $ appsT (return (ConT ''Lens)) [varT t, varT t, conT tyConName, conT tyConName] ]]- ++ filter (\_ -> cfg^.createInstance)- [ instanceD (return []) (conT clsName `appT` conT tyConName)- [ funD methodName [clause [varP a] (normalB (varE a)) []]-#ifdef INLINING- , inlinePragma methodName-#endif- ]]-+ t <- newName "t"+ a <- newName "a"+ --TODO: there's probably a more efficient way to do this. lensFields <- map (\xs -> (fst $ head xs, map snd xs)) . groupBy ((==) `on` fst) . sortBy (comparing fst)@@ -485,8 +468,7 @@ (tyArgs', cty) <- unifyTypes tyArgs fieldTypes -- Map for the polymorphic variables that are only involved in these fields, to new names for them. m <- freshMap . Set.difference varSet $ Set.fromList otherVars- x <- newName "x"- let aty | isJust maybeClassName = VarT x+ let aty | isJust maybeClassName = VarT t | otherwise = appArgs (ConT tyConName) tyArgs' bty = substTypeVars m aty dty = substTypeVars m cty@@ -497,10 +479,10 @@ tvs = tyArgs' ++ filter relevantBndr (substTypeVars m tyArgs') ps = ctx ++ filter relevantCtx (substTypeVars m ctx) qs = case maybeClassName of- Just n -> ClassP n [VarT x] : ps- _ -> ps- tvs' | isJust maybeClassName = PlainTV x : tvs- | otherwise = tvs+ Just n | not (cfg^.createClass) -> ClassP n [VarT t] : ps+ _ -> ps+ tvs' | isJust maybeClassName && not (cfg^.createClass) = PlainTV t : tvs+ | otherwise = tvs --TODO: Better way to write this? fieldMap = fromListWith (++) $ map (\(cn,fn,_) -> (cn, [fn])) fields@@ -537,7 +519,25 @@ inlining <- inlinePragma lensName return [decl, body, inlining] #endif- return $ classDecls ++ Prelude.concat bodies+ let defs = Prelude.concat bodies+ case maybeLensClass of+ Nothing -> return defs+ Just (clsNameString, methodNameString) -> do+ let clsName = mkName clsNameString+ methodName = mkName methodNameString+ Prelude.sequence $+ filter (\_ -> cfg^.createClass) [+ classD (return []) clsName [PlainTV t] [] (+ sigD methodName (appsT (conT ''Lens) [varT t, varT t, conT tyConName, conT tyConName]) :+ map return defs)]+ ++ filter (\_ -> cfg^.createInstance) [+ instanceD (return []) (conT clsName `appT` conT tyConName) [+ funD methodName [clause [varP a] (normalB (varE a)) []]+#ifdef INLINING+ , inlinePragma methodName+#endif+ ]]+ ++ filter (\_ -> not $ cfg^.createClass) (map return defs) -- | Gets @[(lens name, (constructor name, field name, type))]@ from a record constructor getLensFields :: (String -> Maybe String) -> Con -> Q [(Name, (Name, Name, Type))]
src/Control/Lens/Traversal.hs view
@@ -66,6 +66,9 @@ import Control.Monad.Trans.State.Lazy as Lazy import Data.Traversable +-- $setup+-- >>> import Control.Lens+ ------------------------------------------------------------------------------ -- Traversals ------------------------------------------------------------------------------@@ -108,8 +111,12 @@ -- Map each element of a structure targeted by a Lens or Traversal, -- evaluate these actions from left to right, and collect the results. --+-- This function is only provided for consistency, 'id' is strictly more general.+-- -- @'traverseOf' ≡ 'id'@ --+-- This yields the obvious law:+-- -- @'traverse' ≡ 'traverseOf' 'traverse'@ -- -- @@@ -121,12 +128,17 @@ traverseOf = id {-# INLINE traverseOf #-} --- |+-- | A version of 'traverseOf' with the arguments flipped, such that: -- -- @'forOf' l ≡ 'flip' ('traverseOf' l)@ -- -- @ -- 'for' ≡ 'forOf' 'traverse'+-- @+--+-- This function is only provided for consistency, 'flip' is strictly more general.+--+-- @ -- 'forOf' ≡ 'flip' -- @ --@@ -144,9 +156,8 @@ -- the results. -- -- @--- 'sequenceA' ≡ 'sequenceAOf' 'traverse' = 'traverse' 'id'--- 'sequenceAOf' l ≡ 'traverseOf' l id--- 'sequenceAOf' l ≡ l id+-- 'sequenceA' ≡ 'sequenceAOf' 'traverse' ≡ 'traverse' 'id'+-- 'sequenceAOf' l ≡ 'traverseOf' l id ≡ l id -- @ -- -- @@@ -172,7 +183,7 @@ mapMOf l cmd = unwrapMonad . l (WrapMonad . cmd) {-# INLINE mapMOf #-} --- |+-- | 'forMOf' is a flipped version of 'mapMOf', consistent with the definition of 'forM'. -- @ -- 'forM' ≡ 'forMOf' 'traverse' -- 'forMOf' l ≡ 'flip' ('mapMOf' l)@@ -187,7 +198,8 @@ forMOf l a cmd = unwrapMonad (l (WrapMonad . cmd) a) {-# INLINE forMOf #-} --- |+-- | Sequence the (monadic) effects targeted by a lens in a container from left to right.+-- -- @ -- 'sequence' ≡ 'sequenceOf' 'traverse' -- 'sequenceOf' l ≡ 'mapMOf' l id@@ -220,7 +232,7 @@ transposeOf l = getZipList . l ZipList {-# INLINE transposeOf #-} --- | Generalizes 'Data.Traversable.mapAccumR' to an arbitrary 'Traversal'.+-- | This generalizes 'Data.Traversable.mapAccumR' to an arbitrary 'Traversal'. -- -- @'mapAccumR' ≡ 'mapAccumROf' 'traverse'@ --@@ -235,7 +247,7 @@ mapAccumROf l f s0 a = swap (Lazy.runState (l (\c -> State.state (\s -> swap (f s c))) a) s0) {-# INLINE mapAccumROf #-} --- | Generalized 'Data.Traversable.mapAccumL' to an arbitrary 'Traversal'.+-- | This generalizes 'Data.Traversable.mapAccumL' to an arbitrary 'Traversal'. -- -- @'mapAccumL' ≡ 'mapAccumLOf' 'traverse'@ --@@ -254,7 +266,7 @@ swap (a,b) = (b,a) {-# INLINE swap #-} --- | Permit the use of 'scanr1' over an arbitrary 'Traversal' or 'Lens'.+-- | This permits the use of 'scanr1' over an arbitrary 'Traversal' or 'Lens'. -- -- @'scanr1' ≡ 'scanr1Of' 'traverse'@ --@@ -269,14 +281,14 @@ step (Just s) c = (Just r, r) where r = f c s {-# INLINE scanr1Of #-} --- | Permit the use of 'scanl1' over an arbitrary 'Traversal' or 'Lens'.+-- | This permits the use of 'scanl1' over an arbitrary 'Traversal' or 'Lens'. -- -- @'scanl1' ≡ 'scanl1Of' 'traverse'@ -- -- @--- 'scanr1Of' :: Iso a b c c -> (c -> c -> c) -> a -> b--- 'scanr1Of' :: Lens a b c c -> (c -> c -> c) -> a -> b--- 'scanr1Of' :: Traversal a b c c -> (c -> c -> c) -> a -> b+-- 'scanr1Of' :: 'Control.Lens.Iso.Iso' a b c c -> (c -> c -> c) -> a -> b+-- 'scanr1Of' :: 'Lens' a b c c -> (c -> c -> c) -> a -> b+-- 'scanr1Of' :: 'Traversal' a b c c -> (c -> c -> c) -> a -> b -- @ scanl1Of :: LensLike (Backwards (Lazy.State (Maybe c))) a b c c -> (c -> c -> c) -> a -> b scanl1Of l f = snd . mapAccumLOf l step Nothing where@@ -292,7 +304,6 @@ -- -- Attempts to access beyond the range of the 'Traversal' will cause an error. ----- >>> import Control.Lens -- >>> [[1],[3,4]]^.elementOf (traverse.traverse) 1 -- 3 elementOf :: Functor f => LensLike (ElementOf f) a b c c -> Int -> LensLike f a b c c@@ -303,7 +314,7 @@ where go c = ElementOf $ \j -> if i == j then Found (j + 1) (f c) else Searching (j + 1) c --- | Access the nth element of a 'Traversable' container.+-- | Access the /nth/ element of a 'Traversable' container. -- -- Attempts to access beyond the range of the 'Traversal' will cause an error. --@@ -315,7 +326,7 @@ -- Traversals ------------------------------------------------------------------------------ --- | This is the traversal that just doesn't return anything+-- | This is the trivial empty traversal. -- -- @'ignored' :: 'Applicative' f => (c -> f d) -> a -> f a@ --@@ -325,12 +336,28 @@ {-# INLINE ignored #-} -- | Traverse both parts of a tuple with matching types.+--+-- >>> both *~ 10 $ (1,2)+-- (10,20)+-- >>> over both length ("hello","world")+-- (5,5)+-- >>> ("hello","world")^.both+-- "helloworld" both :: Traversal (a,a) (b,b) a b both f (a,a') = (,) <$> f a <*> f a' {-# INLINE both #-} -- | A traversal for tweaking the left-hand value of an 'Either': --+-- >>> over traverseLeft (+1) (Left 2)+-- Left 3+-- >>> over traverseLeft (+1) (Right 2)+-- Right 2+-- >>> Right 42 ^.traverseLeft :: String+-- ""+-- >>> Left "hello" ^.traverseLeft+-- "hello"+-- -- @traverseLeft :: 'Applicative' f => (a -> f b) -> 'Either' a c -> f ('Either' b c)@ traverseLeft :: Traversal (Either a c) (Either b c) a b traverseLeft f (Left a) = Left <$> f a@@ -345,6 +372,15 @@ -- @'Data.Traversable.Traversable' ('Either' c)@ is still missing from base, -- so this can't just be 'Data.Traversable.traverse' --+-- >>> over traverseRight (+1) (Left 2)+-- Left 2+-- >>> over traverseRight (+1) (Right 2)+-- Right 3+-- >>> Right "hello" ^.traverseRight+-- "hello"+-- >>> Left "hello" ^.traverseRight :: [Double]+-- []+-- -- @traverseRight :: 'Applicative' f => (a -> f b) -> 'Either' c a -> f ('Either' c a)@ traverseRight :: Traversal (Either c a) (Either c b) a b traverseRight _ (Left c) = pure $ Left c@@ -368,6 +404,10 @@ -- Note: It is usually better to 'ReifyTraversal' and use 'reflectTraversal' -- than to 'cloneTraversal'. The former can execute at full speed, while the -- latter needs to round trip through the 'Bazaar'.+--+-- >>> let foo l a = (view (cloneTraversal l) a, set (cloneTraversal l) 10 a)+-- >>> foo both ("hello","world")+-- ("helloworld",(10,10)) cloneTraversal :: Applicative f => ((c -> Bazaar c d d) -> a -> Bazaar c d b) -> (c -> f d) -> a -> f b cloneTraversal l f = bazaar f . l sell {-# INLINE cloneTraversal #-}
src/Control/Lens/Tuple.hs view
@@ -31,11 +31,13 @@ import Control.Lens.Type import Data.Functor +-- $setup+-- >>> import Control.Lens+ -- | Provides access to 1st field of a tuple. class Field1 a b c d | a -> c, b -> d, a d -> b, b c -> a where -- | Access the 1st field of a tuple (and possibly change its type). --- -- >>> import Control.Lens -- >>> (1,2)^._1 -- 1 --@@ -92,7 +94,6 @@ class Field2 a b c d | a -> c, b -> d, a d -> b, b c -> a where -- | Access the 2nd field of a tuple --- -- >>> import Control.Lens -- >>> _2 .~ "hello" $ (1,(),3,4) -- (1,"hello",3,4) --
src/Control/Lens/Type.hs view
@@ -30,7 +30,7 @@ -- -- @type 'Lens' a b c d = forall f. 'Functor' f => (c -> f d) -> a -> f b@ ----- Every 'Lens' is a valid 'Setter', choosing @f@ =+-- Every 'Lens' is a valid 'Control.Lens.Setter.Setter', choosing @f@ = -- 'Control.Lens.Getter.Mutator'. -- -- Every 'Lens' can be used for 'Control.Lens.Getter.Getting' like a@@ -63,18 +63,21 @@ , resultAt -- * Lateral Composition- , merged+ , choosing+ , chosen , alongside -- * Setting Functionally with Passthrough , (<%~), (<+~), (<-~), (<*~), (<//~) , (<^~), (<^^~), (<**~) , (<||~), (<&&~)+ , (<<%~), (<<.~) -- * Setting State with Passthrough , (<%=), (<+=), (<-=), (<*=), (<//=) , (<^=), (<^^=), (<**=) , (<||=), (<&&=)+ , (<<%=), (<<.=) -- * Cloning Lenses , cloneLens@@ -93,10 +96,13 @@ import Control.Lens.Internal import Control.Monad.State.Class as State +-- $setup+-- >>> import Control.Lens+ infixr 4 %%~ infix 4 %%=-infixr 4 <+~, <*~, <-~, <//~, <^~, <^^~, <**~, <&&~, <||~, <%~-infix 4 <+=, <*=, <-=, <//=, <^=, <^^=, <**=, <&&=, <||=, <%=+infixr 4 <+~, <*~, <-~, <//~, <^~, <^^~, <**~, <&&~, <||~, <%~, <<%~, <<.~+infix 4 <+=, <*=, <-=, <//=, <^=, <^^=, <**=, <&&=, <||=, <%=, <<%=, <<.= -------------------------------------------------------------------------------@@ -126,7 +132,7 @@ -- it a Lens Family?\" section of -- <http://comonad.com/reader/2012/mirrored-lenses/>. ----- Every 'Lens' can be used directly as a 'Setter' or+-- Every 'Lens' can be used directly as a 'Control.Lens.Setter.Setter' or -- 'Control.Lens.Traversal.Traversal'. -- -- You can also use a 'Lens' for 'Control.Lens.Getter.Getting' as if it were a@@ -266,17 +272,44 @@ {-# INLINE resultAt #-} -- | Merge two lenses, getters, setters, folds or traversals.-merged :: Functor f+--+-- @'chosen' ≡ 'choosing' 'id' 'id'@+--+-- @+-- 'choosing' :: 'Control.Lens.Getter.Getter' a c -> 'Control.Lens.Getter.Getter' b c -> 'Control.Lens.Getter.Getter' ('Either' a b) c+-- 'choosing' :: 'Control.Lens.Fold.Fold' a c -> 'Control.Lens.Fold.Fold' b c -> 'Control.Lens.Fold.Fold' ('Either' a b) c+-- 'choosing' :: 'Simple' 'Lens' a c -> 'Simple' 'Lens' b c -> 'Simple' 'Lens' ('Either' a b) c+-- 'choosing' :: 'Simple' 'Control.Lens.Traversal.Traversal' a c -> 'Simple' 'Control.Lens.Traversal.Traversal' b c -> 'Simple' 'Control.Lens.Traversal.Traversal' ('Either' a b) c+-- 'choosing' :: 'Simple' 'Control.Lens.Setter.Setter' a c -> 'Simple' 'Control.Lens.Setter.Setter' b c -> 'Simple' 'Control.Lens.Setter.Setter' ('Either' a b) c+-- @+choosing :: Functor f => LensLike f a b c c -> LensLike f a' b' c c -> LensLike f (Either a a') (Either b b') c c-merged l _ f (Left a) = Left <$> l f a-merged _ r f (Right a') = Right <$> r f a'-{-# INLINE merged #-}+choosing l _ f (Left a) = Left <$> l f a+choosing _ r f (Right a') = Right <$> r f a'+{-# INLINE choosing #-} --- | 'alongside' makes a 'Lens' from two other lenses (or isomorphisms)-alongside :: Lens a b c d- -> Lens a' b' c' d'+-- | This is a 'Lens' that updates either side of an 'Either', where both sides have the same type.+--+-- @'chosen' ≡ 'choosing' 'id' 'id'@+--+-- >>> Left 12^.chosen+-- 12+-- >>> Right "hello"^.chosen+-- "hello"+-- >>> chosen *~ 10 $ Right 2+-- Right 20+chosen :: Lens (Either a a) (Either b b) a b+chosen f (Left a) = Left <$> f a+chosen f (Right a) = Right <$> f a+{-# INLINE chosen #-}++-- | 'alongside' makes a 'Lens' from two other lenses.+--+-- @'alongside' :: 'Lens' a b c d -> 'Lens' a' b' c' d' -> 'Lens' (a,a') (b,b') (c,c') (d,d')@+alongside :: LensLike (Context c d) a b c d+ -> LensLike (Context c' d') a' b' c' d' -> Lens (a,a') (b,b') (c,c') (d,d') alongside l r f (a, a') = case l (Context id) a of Context db c -> case r (Context id) a' of@@ -441,6 +474,32 @@ l <&&~ c = l <%~ (&& c) {-# INLINE (<&&~) #-} +-- | Modify the target of a 'Lens', but return the old value.+--+-- When you do not need the result of the addition, ('Control.Lens.Setter.%~') is more flexible.+--+-- @+-- ('<<%~') :: 'Lens' a b c d -> (c -> d) -> a -> (d, b)+-- ('<<%~') :: 'Control.Lens.Iso.Iso' a b c d -> (c -> d) -> a -> (d, b)+-- ('<<%~') :: 'Monoid' d => 'Control.Lens.Traversal.Traversal' a b c d -> (c -> d) -> a -> (d, b)+-- @+(<<%~) :: LensLike ((,)c) a b c d -> (c -> d) -> a -> (c, b)+l <<%~ f = l $ \c -> (c, f c)+{-# INLINE (<<%~) #-}++-- | Modify the target of a 'Lens', but return the old value.+--+-- When you do not need the old value, ('Control.Lens.Setter.%~') is more flexible.+--+-- @+-- ('<<%~') :: 'Lens' a b c d -> d -> a -> (c, b)+-- ('<<%~') :: 'Control.Lens.Iso.Iso' a b c d -> d -> a -> (c, b)+-- ('<<%~') :: 'Monoid' d => 'Control.Lens.Traversal.Traversal' a b c d -> d -> a -> (c, b)+-- @+(<<.~) :: LensLike ((,)c) a b c d -> d -> a -> (c, b)+l <<.~ d = l $ \c -> (c, d)+{-# INLINE (<<.~) #-}+ ------------------------------------------------------------------------------- -- Setting and Remembering State -------------------------------------------------------------------------------@@ -459,9 +518,10 @@ -- ('<%=') :: ('MonadState' a m, 'Monoid' b) => 'Simple' 'Traveral' a b -> (b -> b) -> m b -- @ (<%=) :: MonadState a m => LensLike ((,)d) a a c d -> (c -> d) -> m d-l <%= f = l %%= (\c -> let d = f c in (d,d))+l <%= f = l %%= \c -> let d = f c in (d,d) {-# INLINE (<%=) #-} + -- | Add to the target of a numerically valued 'Lens' into your monad's state -- and return the result. --@@ -581,6 +641,40 @@ (<&&=) :: MonadState a m => SimpleLensLike ((,)Bool) a Bool -> Bool -> m Bool l <&&= b = l <%= (&& b) {-# INLINE (<&&=) #-}++-- | Modify the target of a 'Lens' into your monad's state by a user supplied+-- function and return the /old/ value that was replaced.+--+-- When applied to a 'Control.Lens.Traversal.Traversal', it this will return a monoidal summary of all of the old values+-- present.+--+-- When you do not need the result of the operation, ('Control.Lens.Setter.%=') is more flexible.+--+-- @+-- ('<<%=') :: 'MonadState' a m => 'Simple' 'Lens' a b -> (b -> b) -> m b+-- ('<<%=') :: 'MonadState' a m => 'Simple' 'Control.Lens.Iso.Iso' a b -> (b -> b) -> m b+-- ('<<%=') :: ('MonadState' a m, 'Monoid' b) => 'Simple' 'Traveral' a b -> (b -> b) -> m b+-- @+(<<%=) :: MonadState a m => LensLike ((,)c) a a c d -> (c -> d) -> m c+l <<%= f = l %%= \c -> (c, f c)+{-# INLINE (<<%=) #-}++-- | Modify the target of a 'Lens' into your monad's state by a user supplied+-- function and return the /old/ value that was replaced.+--+-- When applied to a 'Control.Lens.Traversal.Traversal', it this will return a monoidal summary of all of the old values+-- present.+--+-- When you do not need the result of the operation, ('Control.Lens.Setter.%=') is more flexible.+--+-- @+-- ('<<%=') :: 'MonadState' a m => 'Simple' 'Lens' a b -> (b -> b) -> m b+-- ('<<%=') :: 'MonadState' a m => 'Simple' 'Control.Lens.Iso.Iso' a b -> (b -> b) -> m b+-- ('<<%=') :: ('MonadState' a m, 'Monoid' b) => 'Simple' 'Traveral' a b -> (b -> b) -> m b+-- @+(<<.=) :: MonadState a m => LensLike ((,)c) a a c d -> d -> m c+l <<.= d = l %%= \c -> (c,d)+{-# INLINE (<<.=) #-} -- | Useful for storing lenses in containers. newtype ReifiedLens a b c d = ReifyLens { reflectLens :: Lens a b c d }
src/Control/Lens/WithIndex.hs view
@@ -73,6 +73,9 @@ import Data.Sequence hiding (index) import Data.Traversable +-- $setup+-- >>> import Control.Lens+ ------------------------------------------------------------------------------- -- FunctorWithIndex -------------------------------------------------------------------------------@@ -389,7 +392,6 @@ -- | Access the element of an indexed container where the index matches a predicate. ----- >>> import Control.Lens -- >>> over (iwhere (>0)) Prelude.reverse $ ["He","was","stressed","o_O"] -- ["He","saw","desserts","O_o"] iwhere :: (TraversableWithIndex i t) => (i -> Bool) -> SimpleIndexedTraversal i (t a) a
src/Control/Lens/Zoom.hs view
@@ -155,51 +155,3 @@ instance Magnify m n k b a => Magnify (IdentityT m) (IdentityT n) k b a where magnify l (IdentityT m) = IdentityT (magnify l m) {-# INLINE magnify #-}--{---- | Wrap a monadic effect with a phantom type argument. Used when magnifying StateT.-newtype EffectS s k c a = EffectS { runEffect :: s -> k (c, s) a }--instance Functor (k (c, s)) => Functor (EffectS s k c) where- fmap f (EffectS m) = EffectS (fmap f . m)---instance (Monoid c, Monad m) => Applicative (EffectS s k c) where- pure _ = EffectS $ \s -> return (mempty, s)- EffectS m <*> EffectS n = EffectS $ \s -> m s >>= \ (c,t) -> n s >>= \ (d, u) -> return (mappend c d, u)---instance Magnify m n k b a => Magnify (Strict.StateT s m) (Strict.StateT s n) (EffectS s k) b a where- magnify l (Strict.StateT m) = Strict.StateT $ magnify l . m- {-# INLINE magnify #-}--instance Magnify m n b a => Magnify (Lazy.StateT s m) (Lazy.StateT s n) b a where- magnify l (Lazy.StateT m) = Lazy.StateT $ magnify l . m- {-# INLINE magnify #-}--instance (Monoid w, Magnify m n b a) => Magnify (Strict.WriterT w m) (Strict.WriterT w n) b a where- magnify l (Strict.WriterT m) = Strict.WriterT (magnify l m)- {-# INLINE magnify #-}--instance (Monoid w, Magnify m n b a) => Magnify (Lazy.WriterT w m) (Lazy.WriterT w n) b a where- magnify l (Lazy.WriterT m) = Lazy.WriterT (magnify l m)- {-# INLINE magnify #-}--instance Magnify m n b a => Magnify (ListT m) (ListT n) b a where- magnify l (ListT m) = ListT (magnify l m)- {-# INLINE magnify #-}--instance Magnify m n b a => Magnify (MaybeT m) (MaybeT n) b a where- magnify l (MaybeT m) = MaybeT (magnify l m)- {-# INLINE magnify #-}--instance (Error e, Magnify m n b a) => Magnify (ErrorT e m) (ErrorT e n) b a where- magnify l (ErrorT m) = ErrorT (magnify l m)- {-# INLINE magnify #-}--instance Magnify m m a a => Magnify (ContT r m) (ContT r m) a a where- magnify l (ContT m) = ContT $ \k -> do- r <- Reader.ask- magnify l (m (magnify (to (const r)) . k))- {-# INLINE magnify #-}--}
src/Data/Complex/Lens.hs view
@@ -20,7 +20,10 @@ -- | Access the 'realPart' of a 'Complex' number ----- > real :: Functor f => (a -> f a) -> Complex a -> f (Complex a)+-- >>> (1.0 :+ 0.0)^.real+-- 1.0+--+-- @'real' :: 'Functor' f => (a -> f a) -> 'Complex' a -> f ('Complex' a)@ #if MIN_VERSION_base(4,4,0) real :: Simple Lens (Complex a) a #else@@ -30,7 +33,10 @@ -- | Access the 'imaginaryPart' of a 'Complex' number ----- > imaginary :: Functor f => (a -> f a) -> Complex a -> f (Complex a)+-- >>> (0.0 :+ 1.0)^.imaginary+-- 1.0+--+-- @'imaginary' :: 'Functor' f => (a -> f a) -> 'Complex' a -> f ('Complex' a)@ #if MIN_VERSION_base(4,4,0) imaginary :: Simple Lens (Complex a) a #else@@ -46,7 +52,6 @@ -- as the 'phase' information is lost. So don't do that! -- -- Otherwise, this is a perfectly cromulent 'Lens'.- polarize :: (RealFloat a, RealFloat b) => Iso (Complex a) (Complex b) (a,a) (b,b) polarize = isos polar (uncurry mkPolar) polar (uncurry mkPolar)
src/Data/Dynamic/Lens.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE FlexibleContexts #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Dynamic.Lens@@ -9,10 +10,9 @@ -- ---------------------------------------------------------------------------- module Data.Dynamic.Lens- ( traverseDynamic+ ( dynamic ) where -import Control.Applicative import Control.Lens import Data.Dynamic @@ -20,9 +20,8 @@ -- Traverse the typed value contained in a 'Dynamic' where the type required by your function matches that -- of the contents of the 'Dynamic'. ----- > traverseDynamic :: (Applicative f, Typeable a, Typeable b) => (a -> f b) -> Dynamic -> f Dynamic-traverseDynamic :: (Typeable a, Typeable b) => Traversal Dynamic Dynamic a b-traverseDynamic f dyn = case fromDynamic dyn of- Just a -> toDyn <$> f a- Nothing -> pure dyn-{-# INLINE traverseDynamic #-}+-- >>> ()^.by dynamic+-- <<()>>+dynamic :: (Typeable a, Typeable b) => Projection Dynamic Dynamic a b+dynamic = projection toDyn fromDynamic+{-# INLINE dynamic #-}
src/Data/HashSet/Lens.hs view
@@ -20,31 +20,32 @@ import Data.HashSet as HashSet import Data.Hashable +-- $setup+-- >>> :m + Data.HashSet Control.Lens+ -- | This 'Setter' can be used to change the type of a 'HashSet' by mapping -- the elements to new values. ----- Sadly, you can't create a valid 'Traversal' for a 'Set', but you can+-- Sadly, you can't create a valid 'Control.Lens.Traversal.Traversal' for a 'Set', but you can -- manipulate it by reading using 'folded' and reindexing it via 'setmap'. ----- >>> :m + Data.HashSet Control.Lens -- >>> over setmapped (+1) (fromList [1,2,3,4]) -- fromList [2,3,4,5] setmapped :: (Eq i, Hashable i, Eq j, Hashable j) => Setter (HashSet i) (HashSet j) i j setmapped = sets HashSet.map {-# INLINE setmapped #-} --- | Construct a set from a 'Getter', 'Fold', 'Traversal', 'Lens' or 'Iso'.+-- | Construct a set from a 'Getter', 'Control.Lens.Fold.Fold', 'Control.Lens.Traversal.Traversal', 'Control.Lens.Type.Lens' or 'Control.Lens.Iso.Iso'. ----- >>> :m + Control.Lens -- >>> setOf (folded._2) [("hello",1),("world",2),("!!!",3)] -- fromList [1,2,3] -- -- @--- setOf :: 'Hashable' c => 'Getter' a c -> a -> 'HashSet' c--- setOf :: ('Eq' c, 'Hashable' c) => 'Fold' a c -> a -> 'HashSet' c--- setOf :: 'Hashable' c => 'Simple' 'Iso' a c -> a -> 'HashSet' c--- setOf :: 'Hashable' c => 'Simple' 'Lens' a c -> a -> 'HashSet' c--- setOf :: ('Eq' c, 'Hashable' c) => 'Simple' 'Traversal' a c -> a -> 'HashSet' c+-- 'setOf' :: 'Hashable' c => 'Getter' a c -> a -> 'HashSet' c+-- 'setOf' :: ('Eq' c, 'Hashable' c) => 'Control.Lens.Fold.Fold' a c -> a -> 'HashSet' c+-- 'setOf' :: 'Hashable' c => 'Control.Lens.Type.Simple' 'Control.Lens.Iso.Iso' a c -> a -> 'HashSet' c+-- 'setOf' :: 'Hashable' c => 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a c -> a -> 'HashSet' c+-- 'setOf' :: ('Eq' c, 'Hashable' c) => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a c -> a -> 'HashSet' c -- @ setOf :: Hashable c => Getting (HashSet c) a b c d -> a -> HashSet c setOf l = runAccessor . l (Accessor . HashSet.singleton)
src/Data/IntSet/Lens.hs view
@@ -19,6 +19,9 @@ import Control.Lens.Internal import Data.IntSet as IntSet +-- $setup+-- >>> :m + Data.IntSet.Lens Control.Lens+ -- | IntSet isn't Foldable, but this 'Fold' can be used to access the members of an 'IntSet'. -- -- >>> sumOf members $ setOf folded [1,2,3,4]@@ -32,7 +35,7 @@ -- -- Sadly, you can't create a valid 'Traversal' for a 'Set', because the number of -- elements might change but you can manipulate it by reading using 'folded' and--- reindexing it via 'setmap'.+-- reindexing it via 'setmapped'. -- -- >>> over setmapped (+1) (fromList [1,2,3,4]) -- fromList [2,3,4,5]@@ -42,16 +45,15 @@ -- | Construct an 'IntSet' from a 'Getter', 'Fold', 'Traversal', 'Lens' or 'Iso'. ----- >>> :m + Data.IntSet.Lens Control.Lens -- >>> setOf (folded._2) [("hello",1),("world",2),("!!!",3)] -- fromList [1,2,3] -- -- @--- setOf :: 'Getter' a 'Int' -> a -> 'IntSet'--- setOf :: 'Fold' a 'Int' -> a -> 'IntSet'--- setOf :: 'Simple' 'Iso' a 'Int' -> a -> 'IntSet'--- setOf :: 'Simple' 'Lens' a 'Int' -> a -> 'IntSet'--- setOf :: 'Simple' 'Traversal' a 'Int' -> a -> 'IntSet'+-- 'setOf' :: 'Getter' a 'Int' -> a -> 'IntSet'+-- 'setOf' :: 'Fold' a 'Int' -> a -> 'IntSet'+-- 'setOf' :: 'Simple' 'Iso' a 'Int' -> a -> 'IntSet'+-- 'setOf' :: 'Simple' 'Lens' a 'Int' -> a -> 'IntSet'+-- 'setOf' :: 'Simple' 'Traversal' a 'Int' -> a -> 'IntSet' -- @ setOf :: Getting IntSet a b Int d -> a -> IntSet setOf l = runAccessor . l (Accessor . IntSet.singleton)
src/Data/Sequence/Lens.hs view
@@ -19,7 +19,7 @@ ) where import Control.Applicative-import Control.Lens as Lens hiding ((|>))+import Control.Lens as Lens import Data.Monoid import Data.Sequence as Seq
src/Data/Set/Lens.hs view
@@ -19,31 +19,32 @@ import Control.Lens.Setter import Data.Set as Set +-- $setup+-- >>> :m + Data.Set.Lens Control.Lens+ -- | This 'Setter' can be used to change the type of a 'Set' by mapping -- the elements to new values. ----- Sadly, you can't create a valid 'Traversal' for a 'Set', but you can--- manipulate it by reading using 'folded' and reindexing it via 'setmap'.+-- Sadly, you can't create a valid 'Control.Lens.Traversal.Traversal' for a 'Set', but you can+-- manipulate it by reading using 'Control.Lens.Fold.folded' and reindexing it via 'setmapped'. ----- >>> :m + Data.Set.Lens Control.Lens -- >>> over setmapped (+1) (fromList [1,2,3,4]) -- fromList [2,3,4,5] setmapped :: (Ord i, Ord j) => Setter (Set i) (Set j) i j setmapped = sets Set.map {-# INLINE setmapped #-} --- | Construct a set from a 'Getter', 'Fold', 'Traversal', 'Lens' or 'Iso'.+-- | Construct a set from a 'Getter', 'Control.Lens.Fold.Fold', 'Control.Lens.Traversal.Traversal', 'Control.Lens.Type.Lens' or 'Control.Lens.Iso.Iso'. ----- >>> :m + Data.Set.Lens Control.Lens -- >>> setOf (folded._2) [("hello",1),("world",2),("!!!",3)] -- fromList [1,2,3] -- -- @--- setOf :: 'Getter' a c -> a -> 'Set' c--- setOf :: 'Ord' c => 'Fold' a c -> a -> 'Set' c--- setOf :: 'Simple' 'Iso' a c -> a -> 'Set' c--- setOf :: 'Simple' 'Lens' a c -> a -> 'Set' c--- setOf :: 'Ord' c => 'Simple' 'Traversal' a c -> a -> 'Set' c+-- 'setOf' :: 'Getter' a c -> a -> 'Set' c+-- 'setOf' :: 'Ord' c => 'Control.Lens.Fold.Fold' a c -> a -> 'Set' c+-- 'setOf' :: 'Control.Lens.Type.Simple' 'Control.Lens.Iso.Iso' a c -> a -> 'Set' c+-- 'setOf' :: 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a c -> a -> 'Set' c+-- 'setOf' :: 'Ord' c => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a c -> a -> 'Set' c -- @ setOf :: Getting (Set c) a b c d -> a -> Set c setOf l = runAccessor . l (Accessor . Set.singleton)
src/Data/Tree/Lens.hs view
@@ -21,12 +21,17 @@ import Data.Tree -- | A 'Lens' that focuses on the root of a 'Tree'.+--+-- >>> view root $ Node 42 []+-- 42 root :: Simple Lens (Tree a) a root f (Node a as) = (`Node` as) <$> f a {-# INLINE root #-} -- | A 'Traversal' of the direct descendants of the root of a 'Tree' -- indexed by its position in the list of children+--+-- @'toListOf' 'branches' ≡ 'subForest'@ branches :: SimpleIndexedTraversal Int (Tree a) (Tree a) branches = index $ \ f (Node a as) -> Node a <$> withIndex traverseList f as {-# INLINE branches #-}
src/Data/Typeable/Lens.hs view
@@ -22,13 +22,13 @@ -- | A 'Simple' 'Traversal' for working with a 'cast' of a 'Typeable' value. _cast :: (Typeable a, Typeable b) => Simple Traversal a b _cast f a = case cast a of- Just b -> Unsafe.unsafeCoerce <$> f b+ Just b -> Unsafe.unsafeCoerce <$> f b Nothing -> pure a {-# INLINE _cast #-} -- | A 'Simple' 'Traversal' for working with a 'gcast' of a 'Typeable' value. _gcast :: (Typeable a, Typeable b) => Simple Traversal (c a) (c b) _gcast f a = case gcast a of- Just b -> Unsafe.unsafeCoerce <$> f b+ Just b -> Unsafe.unsafeCoerce <$> f b Nothing -> pure a {-# INLINE _gcast #-}
tests/hunit.hs view
@@ -16,12 +16,6 @@ -- of each available lens function. The tests here merely scratch the surface -- of what is possible using the lens package; there are a great many use cases -- (and lens functions) that aren't covered.------ Here are some use cases that are not covered:--- * In the state monad, access some field(s), apply monadic function(s) and--- access the result.--- * In the state monad, modify some field(s) by applying a monadic rather than--- a pure function to them. data Point = Point@@ -77,11 +71,6 @@ where test = use $ box.high.y --- TODO: Having to write @. to@ all the time isn't nice. In an ideal world,--- we'd be able to avoid the @to@. If at all possible, this would require heavy--- type wizardry, as the default behavior of @f . g@ is already defined to work--- in the other way than we need.- case_read_record_field_and_apply_function = (trig^.points.to last.to (vectorFrom origin).x) @?= 8@@ -91,143 +80,143 @@ where test = use $ points.to last.to (vectorFrom origin).x case_write_record_field =- (trig |> box.high.y .~ 6)- @?= trig { _box = (trig |> _box)- { _high = (trig |> _box |> _high)+ (trig % box.high.y .~ 6)+ @?= trig { _box = (trig % _box)+ { _high = (trig % _box % _high) { _y = 6 } } } case_write_state_record_field = do- let trig' = trig { _box = (trig |> _box)- { _high = (trig |> _box |> _high)+ let trig' = trig { _box = (trig % _box)+ { _high = (trig % _box % _high) { _y = 6 } } } runState test trig @?= ((), trig') where test = box.high.y .= 6 case_write_record_field_and_access_new_value =- (trig |> box.high.y <.~ 6)- @?= (6, trig { _box = (trig |> _box)- { _high = (trig |> _box |> _high)+ (trig % box.high.y <.~ 6)+ @?= (6, trig { _box = (trig % _box)+ { _high = (trig % _box % _high) { _y = 6 } } }) case_write_state_record_field_and_access_new_value = do- let trig' = trig { _box = (trig |> _box)- { _high = (trig |> _box |> _high)+ let trig' = trig { _box = (trig % _box)+ { _high = (trig % _box % _high) { _y = 6 } } } runState test trig @?= (6, trig') where test = box.high.y <.= 6 --- case_write_record_field_and_access_old_value =--- (trig |> box.high.y <<.~ 6)--- @?= (7, trig { _box = (trig |> _box)--- { _high = (trig |> _box |> _high)--- { _y = 6 } } })------ case_write_state_record_field_and_access_old_value = do--- let trig' = trig { _box = (trig |> _box)--- { _high = (trig |> _box |> _high)--- { _y = 6 } } }--- runState test trig @?= (7, trig')--- where--- test = box.high.y <<.= 6+case_write_record_field_and_access_old_value =+ (trig % box.high.y <<.~ 6)+ @?= (7, trig { _box = (trig % _box)+ { _high = (trig % _box % _high)+ { _y = 6 } } }) +case_write_state_record_field_and_access_old_value = do+ let trig' = trig { _box = (trig % _box)+ { _high = (trig % _box % _high)+ { _y = 6 } } }+ runState test trig @?= (7, trig')+ where+ test = box.high.y <<.= 6+ case_modify_record_field =- (trig |> box.low.y %~ (+ 2))- @?= trig { _box = (trig |> _box)- { _low = (trig |> _box |> _low)- { _y = ((trig |> _box |> _low |> _y) + 2) } } }+ (trig % box.low.y %~ (+ 2))+ @?= trig { _box = (trig % _box)+ { _low = (trig % _box % _low)+ { _y = ((trig % _box % _low % _y) + 2) } } } case_modify_state_record_field = do- let trig' = trig { _box = (trig |> _box)- { _low = (trig |> _box |> _low)- { _y = ((trig |> _box |> _low |> _y) + 2) } } }+ let trig' = trig { _box = (trig % _box)+ { _low = (trig % _box % _low)+ { _y = ((trig % _box % _low % _y) + 2) } } } runState test trig @?= ((), trig') where test = box.low.y %= (+ 2) case_modify_record_field_and_access_new_value =- (trig |> box.low.y <%~ (+ 2))- @?= (2, trig { _box = (trig |> _box)- { _low = (trig |> _box |> _low)- { _y = ((trig |> _box |> _low |> _y) + 2) } } })+ (trig % box.low.y <%~ (+ 2))+ @?= (2, trig { _box = (trig % _box)+ { _low = (trig % _box % _low)+ { _y = ((trig % _box % _low % _y) + 2) } } }) case_modify_state_record_field_and_access_new_value = do- let trig' = trig { _box = (trig |> _box)- { _low = (trig |> _box |> _low)- { _y = ((trig |> _box |> _low |> _y) + 2) } } }+ let trig' = trig { _box = (trig % _box)+ { _low = (trig % _box % _low)+ { _y = ((trig % _box % _low % _y) + 2) } } } runState test trig @?= (2, trig') where test = box.low.y <%= (+ 2) --- case_modify_record_field_and_access_old_value =--- (trig |> box.low.y <<%~ (+ 2))--- @?= (0, trig { _box = (trig |> _box)--- { _low = (trig |> _box |> _low)--- { _y = ((trig |> _box |> _low |> _y) + 2) } } })------ case_modify_state_record_field_and_access_old_value = do--- let trig' = trig { _box = (trig |> _box)--- { _low = (trig |> _box |> _low)--- { _y = ((trig |> _box |> _low |> _y) + 2) } } }--- runState test trig @?= (0, trig')--- where--- test = box.low.y <<%= (+ 2)+case_modify_record_field_and_access_old_value =+ (trig % box.low.y <<%~ (+ 2))+ @?= (0, trig { _box = (trig % _box)+ { _low = (trig % _box % _low)+ { _y = ((trig % _box % _low % _y) + 2) } } }) +case_modify_state_record_field_and_access_old_value = do+ let trig' = trig { _box = (trig % _box)+ { _low = (trig % _box % _low)+ { _y = ((trig % _box % _low % _y) + 2) } } }+ runState test trig @?= (0, trig')+ where+ test = box.low.y <<%= (+ 2)+ case_modify_record_field_and_access_side_result = do runState test trig @?= (8, trig') where test = box.high %%= modifyAndCompute modifyAndCompute point =- (point ^. x, point |> y +~ 2)- trig' = trig { _box = (trig |> _box)- { _high = (trig |> _box |> _high)- { _y = ((trig |> _box |> _high |> _y) + 2) } } }+ (point ^. x, point % y +~ 2)+ trig' = trig { _box = (trig % _box)+ { _high = (trig % _box % _high)+ { _y = ((trig % _box % _high % _y) + 2) } } } case_increment_record_field =- (trig |> box.low.y +~ 1) -- And similarly for -~ *~ //~ ^~ ^^~ **~ ||~ &&~- @?= trig { _box = (trig |> _box)- { _low = (trig |> _box |> _low)- { _y = ((trig |> _box |> _low |> _y) + 1) } } }+ (trig % box.low.y +~ 1) -- And similarly for -~ *~ //~ ^~ ^^~ **~ ||~ &&~+ @?= trig { _box = (trig % _box)+ { _low = (trig % _box % _low)+ { _y = ((trig % _box % _low % _y) + 1) } } } case_increment_state_record_field = runState test trig @?= ((), trig') where test = box.low.y += 1- trig' = trig { _box = (trig |> _box)- { _low = (trig |> _box |> _low)- { _y = ((trig |> _box |> _low |> _y) + 1) } } }+ trig' = trig { _box = (trig % _box)+ { _low = (trig % _box % _low)+ { _y = ((trig % _box % _low % _y) + 1) } } } case_append_to_record_field =- (trig |> points ++~ [ origin ])- @?= trig { _points = (trig |> _points) ++ [ origin ] }+ (trig % points ++~ [ origin ])+ @?= trig { _points = (trig % _points) ++ [ origin ] } case_append_to_state_record_field = do runState test trig @?= ((), trig') where test = points ++= [ origin ]- trig' = trig { _points = (trig |> _points) ++ [ origin ] }+ trig' = trig { _points = (trig % _points) ++ [ origin ] } case_append_to_record_field_and_access_new_value =- (trig |> points <++~ [ origin ])- @?= (_points trig ++ [ origin ], trig { _points = (trig |> _points) ++ [ origin ] })+ (trig % points <++~ [ origin ])+ @?= (_points trig ++ [ origin ], trig { _points = (trig % _points) ++ [ origin ] }) case_append_to_state_record_field_and_access_new_value = do runState test trig @?= (_points trig ++ [ origin ], trig') where test = points <++= [ origin ]- trig' = trig { _points = (trig |> _points) ++ [ origin ] }+ trig' = trig { _points = (trig % _points) ++ [ origin ] } --- case_append_to_record_field_and_access_old_value =--- (trig |> points <<++~ [ origin ])--- @?= (_points trig, trig { _points = (trig |> _points) ++ [ origin ] })------ case_append_to_state_record_field_and_access_old_value = do--- runState test trig @?= (_points trig, trig')--- where--- test = points <<++= [ origin ]--- trig' = trig { _points = (trig |> _points) ++ [ origin ] }+case_append_to_record_field_and_access_old_value =+ (trig % points <<%~ (++[origin]))+ @?= (_points trig, trig { _points = (trig % _points) ++ [ origin ] }) +case_append_to_state_record_field_and_access_old_value = do+ runState test trig @?= (_points trig, trig')+ where+ test = points <<%= (++[origin])+ trig' = trig { _points = (trig % _points) ++ [ origin ] }+ case_read_maybe_map_entry = trig^.labels.at origin @?= Just "Origin" case_read_maybe_state_map_entry =@@ -240,18 +229,18 @@ where test = use $ labels.traverseAt origin case_modify_map_entry =- (trig |> labels.traverseAt origin %~ List.map toUpper)+ (trig % labels.traverseAt origin %~ List.map toUpper) @?= trig { _labels = fromList [ (Point { _x = 0, _y = 0 }, "ORIGIN") , (Point { _x = 4, _y = 7 }, "Peak") ] } case_insert_maybe_map_entry =- (trig |> labels.at (Point { _x = 8, _y = 0 }) .~ Just "Right")+ (trig % labels.at (Point { _x = 8, _y = 0 }) .~ Just "Right") @?= trig { _labels = fromList [ (Point { _x = 0, _y = 0 }, "Origin") , (Point { _x = 4, _y = 7 }, "Peak") , (Point { _x = 8, _y = 0 }, "Right") ] } case_delete_maybe_map_entry =- (trig |> labels.at origin .~ Nothing)+ (trig % labels.at origin .~ Nothing) @?= trig { _labels = fromList [ (Point { _x = 4, _y = 7 }, "Peak") ] } case_read_list_entry =@@ -259,13 +248,13 @@ @?= origin case_write_list_entry =- (trig |> points.element 0 .~ Point { _x = 2, _y = 0 })+ (trig % points.element 0 .~ Point { _x = 2, _y = 0 }) @?= trig { _points = [ Point { _x = 2, _y = 0 } , Point { _x = 4, _y = 7 } , Point { _x = 8, _y = 0 } ] } case_write_through_list_entry =- (trig |> points.element 0 . x .~ 2)+ (trig % points.element 0 . x .~ 2) @?= trig { _points = [ Point { _x = 2, _y = 0 } , Point { _x = 4, _y = 7 } , Point { _x = 8, _y = 0 } ] }