lens 4.12.3 → 4.13
raw patch · 34 files changed
+869/−283 lines, 34 filesdep ~contravariantdep ~reflection
Dependency ranges changed: contravariant, reflection
Files
- .travis.yml +81/−56
- CHANGELOG.markdown +11/−0
- README.markdown +1/−1
- lens.cabal +4/−4
- src/Control/Exception/Lens.hs +222/−5
- src/Control/Lens/Cons.hs +27/−3
- src/Control/Lens/Empty.hs +17/−0
- src/Control/Lens/Fold.hs +40/−58
- src/Control/Lens/Getter.hs +7/−8
- src/Control/Lens/Indexed.hs +15/−4
- src/Control/Lens/Internal/FieldTH.hs +1/−1
- src/Control/Lens/Internal/Fold.hs +1/−23
- src/Control/Lens/Internal/Getter.hs +2/−16
- src/Control/Lens/Internal/Indexed.hs +1/−2
- src/Control/Lens/Internal/TH.hs +7/−2
- src/Control/Lens/Iso.hs +84/−9
- src/Control/Lens/Lens.hs +30/−30
- src/Control/Lens/Plated.hs +4/−4
- src/Control/Lens/Reified.hs +11/−10
- src/Control/Lens/Setter.hs +21/−11
- src/Control/Lens/Traversal.hs +47/−17
- src/Control/Lens/Type.hs +1/−1
- src/Control/Lens/Wrapped.hs +54/−3
- src/Data/ByteString/Lazy/Lens.hs +19/−0
- src/Data/ByteString/Lens.hs +17/−0
- src/Data/ByteString/Strict/Lens.hs +18/−0
- src/Data/Complex/Lens.hs +24/−0
- src/Data/Dynamic/Lens.hs +14/−0
- src/Data/Sequence/Lens.hs +4/−4
- src/Data/Text/Lazy/Lens.hs +15/−0
- src/Data/Text/Lens.hs +17/−0
- src/Data/Text/Strict/Lens.hs +15/−0
- src/Numeric/Lens.hs +13/−0
- src/System/Exit/Lens.hs +24/−11
.travis.yml view
@@ -1,70 +1,94 @@-language: haskell+# This file has been generated -- see https://github.com/hvr/multi-ghc-travis+language: c+sudo: false -env:- - GHCVER=7.4.2- - GHCVER=7.6.3- - GHCVER=7.8.4- - GHCVER=7.10.1- - GHCVER=head- # - >- # GHCVER=7.4.2- # MODE="-fsafe"+cache:+ directories:+ - $HOME/.cabsnap+ - $HOME/.cabal/packages +before_cache:+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.tar+ matrix:- allow_failures:- - env: GHCVER=head+ include:+ - env: CABALVER=1.16 GHCVER=7.4.2+ compiler: ": #GHC 7.4.2"+ addons: {apt: {packages: [cabal-install-1.16,ghc-7.4.2,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}}+ - env: CABALVER=1.16 GHCVER=7.6.3+ compiler: ": #GHC 7.6.3"+ addons: {apt: {packages: [cabal-install-1.16,ghc-7.6.3,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}}+ - env: CABALVER=1.18 GHCVER=7.8.4+ compiler: ": #GHC 7.8.4"+ addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}}+ - env: CABALVER=1.22 GHCVER=7.10.1+ compiler: ": #GHC 7.10.1"+ addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.1,alex-3.1.4,happy-1.19.5], sources: [hvr-ghc]}} before_install:- # If $GHCVER is the one travis has, don't bother reinstalling it.- # We can also have faster builds by installing some libraries with- # `apt`. If it isn't, install the GHC we want from hvr's PPA along- # with cabal-1.18.- - |- if [ $GHCVER = `ghc --numeric-version` ]; then- # Try installing some of the build-deps with apt-get for speed.- travis/cabal-apt-install --enable-tests $MODE- export CABAL=cabal- else- # Install the GHC we want from hvr's PPA- travis_retry sudo add-apt-repository -y ppa:hvr/ghc- travis_retry sudo apt-get update- travis_retry sudo apt-get install cabal-install-1.18 ghc-$GHCVER happy- export CABAL=cabal-1.18- export PATH=/opt/ghc/$GHCVER/bin:$PATH- fi- # Uncomment whenever hackage is down.- # - mkdir -p ~/.cabal && cp travis/config ~/.cabal/config && $CABAL update- - $CABAL update-- # Update happy when building with GHC head- - |- if [ $GHCVER = "head" ] || [ $GHCVER = "7.8.4" ] || [ $GHCVER = "7.10.1" ]; then- $CABAL install --constraint=transformers\ installed happy alex- export PATH=$HOME/.cabal/bin:$PATH- fi+ - unset CC+ - export HAPPYVER=1.19.5+ - export ALEXVER=3.1.4+ - export PATH=~/.cabal/bin:/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:/opt/happy/$HAPPYVER/bin:/opt/alex/$ALEXVER/bin:$PATH install:- - $CABAL install --dependencies-only --enable-tests- - $CABAL configure --enable-tests $MODE+# build reflection HEAD until reflection 2.1 is on hackage+ - git clone https://github.com/ekmett/reflection.git -script:- - $CABAL build- - $CABAL test --show-details=always- - scripts/stats+ - cabal --version+ - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"+ - if [ -f $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz ];+ then+ zcat $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz >+ $HOME/.cabal/packages/hackage.haskell.org/00-index.tar;+ fi+ - travis_retry cabal update+ - "sed -i 's/^jobs:.*$/jobs: 2/' $HOME/.cabal/config"+ - cabal install --only-dependencies --enable-tests --dry -v lens.cabal reflection/ > installplan.txt+ - sed -i -e '1,/^Resolving /d' installplan.txt; cat installplan.txt - # tests that a source-distribution can be generated- - cabal sdist+# check whether current requested install-plan matches cached package-db snapshot+ - if diff -u installplan.txt $HOME/.cabsnap/installplan.txt;+ then+ echo "cabal build-cache HIT";+ rm -rfv .ghc;+ cp -a $HOME/.cabsnap/ghc $HOME/.ghc;+ cp -a $HOME/.cabsnap/lib $HOME/.cabsnap/share $HOME/.cabsnap/bin $HOME/.cabal/;+ else+ echo "cabal build-cache MISS";+ rm -rf $HOME/.cabsnap;+ mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin;+ cabal install --only-dependencies --enable-tests lens.cabal reflection/;+ if [ "$GHCVER" = "7.10.1" ]; then cabal install Cabal-1.22.4.0; fi;+ fi - # check that the generated source-distribution can be built & installed- - export SRC_TGZ=$(cabal info . | awk '{print $2 ".tar.gz";exit}') ;- cd dist/;- if [ -f "$SRC_TGZ" ]; then- cabal install --force-reinstalls "$SRC_TGZ";- else- echo "expected '$SRC_TGZ' not found";- exit 1;- fi+# snapshot package-db on cache miss+ - if [ ! -d $HOME/.cabsnap ];+ then+ echo "snapshotting package-db to build-cache";+ mkdir $HOME/.cabsnap;+ cp -a $HOME/.ghc $HOME/.cabsnap/ghc;+ cp -a $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin installplan.txt $HOME/.cabsnap/;+ fi +# NB: we don't want reflection/ to be included in the cache+ - cabal install reflection/++# Here starts the actual work to be performed for the package under test;+# any command which exits with a non-zero exit code causes the build to fail.+script:+ - cabal configure --enable-tests -v2 # -v2 provides useful information for debugging+ - cabal build # this builds all libraries and executables (including tests)+ - cabal test+ - cabal sdist # tests that a source-distribution can be generated++# Check that the resulting source distribution can be built & installed.+# If there are no other `.tar.gz` files in `dist`, this can be even simpler:+# `cabal install --force-reinstalls dist/*-*.tar.gz`+ - SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz &&+ (cd dist && cabal install --force-reinstalls "$SRC_TGZ")+ notifications: irc: channels:@@ -72,3 +96,4 @@ skip_join: true template: - "\x0313lens\x0f/\x0306%{branch}\x0f \x0314%{commit}\x0f %{message} \x0302\x1f%{build_url}\x0f"+# EOF
CHANGELOG.markdown view
@@ -1,3 +1,14 @@+4.13+----+* Pattern synonyms+* Moved `foldMapBy` and `foldBy` into `reflection` 2.1+* Added `traverseByOf`, `sequenceByOf`.+* Reexported `traverseBy` and `sequenceBy` from `reflection` 2.1.+* Modified the signatures of `alaf` and `auf` to work with a `Functor` rather than a `Profunctor` and rather drastically generalized them.+* Removed `Control.Lens.Internal.Getter.coerce` in favor of the upstream `phantom` combinator in `contravariant` 1.3++* Renamed `coerced` to `phantasm` to get it out of the way.+* Added `Wrapped` instance for `Down`+ 4.12.3 ------ * Move `Review` and `AReview` to `Control.Lens.Type` fixing a bug in `makePrisms`
README.markdown view
@@ -1,7 +1,7 @@ Lens: Lenses, Folds, and Traversals ================================== -[](http://travis-ci.org/ekmett/lens)+[](https://hackage.haskell.org/package/lens) [](http://travis-ci.org/ekmett/lens) 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).
lens.cabal view
@@ -1,6 +1,6 @@ name: lens category: Data, Lenses, Generics-version: 4.12.3+version: 4.13 license: BSD3 cabal-version: >= 1.8 license-file: LICENSE@@ -12,7 +12,7 @@ copyright: Copyright (C) 2012-2015 Edward A. Kmett build-type: Custom -- build-tools: cpphs-tested-with: GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.1+tested-with: GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.1, GHC == 7.10.2 synopsis: Lenses, Folds and Traversals description: This package comes \"Batteries Included\" with many useful lenses for the types@@ -187,7 +187,7 @@ bifunctors >= 5 && < 6, bytestring >= 0.9.1.10 && < 0.11, comonad >= 4 && < 5,- contravariant >= 0.3 && < 2,+ contravariant >= 1.3 && < 2, containers >= 0.4.0 && < 0.6, distributive >= 0.3 && < 1, filepath >= 1.2.0.0 && < 1.5,@@ -199,7 +199,7 @@ mtl >= 2.0.1 && < 2.3, parallel >= 3.1.0.1 && < 3.3, profunctors >= 5 && < 6,- reflection >= 2 && < 3,+ reflection >= 2.1 && < 3, semigroupoids >= 5 && < 6, semigroups >= 0.8.4 && < 1, tagged >= 0.4.4 && < 1,
src/Control/Exception/Lens.hs view
@@ -4,10 +4,16 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NoMonomorphismRestriction #-}+ #ifdef TRUSTWORTHY {-# LANGUAGE Trustworthy #-} #endif +#if __GLASGOW_HASKELL__ >= 710+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE ViewPatterns #-}+#endif+ #ifndef MIN_VERSION_base #define MIN_VERSION_base(x,y,z) 1 #endif@@ -53,55 +59,113 @@ , mappedException, mappedException' -- * Exceptions , exception+#if __GLASGOW_HASKELL__ >= 710+ , pattern Exception+#endif -- * Exception Handlers , Handleable(..) -- ** IOExceptions , AsIOException(..)+#if __GLASGOW_HASKELL__ >= 710+ , pattern IOException_+#endif -- ** Arithmetic Exceptions , AsArithException(..)- , _Overflow- , _Underflow- , _LossOfPrecision- , _DivideByZero- , _Denormal+ , _Overflow, _Underflow, _LossOfPrecision, _DivideByZero, _Denormal #if MIN_VERSION_base(4,6,0) , _RatioZeroDenominator #endif+#if __GLASGOW_HASKELL__ >= 710+ , pattern ArithException_+ , pattern Overflow_+ , pattern Underflow_+ , pattern LossOfPrecision_+ , pattern DivideByZero_+ , pattern Denormal_+ , pattern RatioZeroDenominator_+#endif -- ** Array Exceptions , AsArrayException(..) , _IndexOutOfBounds , _UndefinedElement+#if __GLASGOW_HASKELL__ >= 710+ , pattern ArrayException_+ , pattern IndexOutOfBounds_+ , pattern UndefinedElement_+#endif -- ** Assertion Failed , AsAssertionFailed(..)+#if __GLASGOW_HASKELL__ >= 710+ , pattern AssertionFailed_+#endif -- ** Async Exceptions , AsAsyncException(..) , _StackOverflow , _HeapOverflow , _ThreadKilled , _UserInterrupt+#if __GLASGOW_HASKELL__ >= 710+ , pattern AsyncException_+ , pattern StackOverflow_+ , pattern HeapOverflow_+ , pattern ThreadKilled_+ , pattern UserInterrupt_+#endif -- ** Non-Termination , AsNonTermination(..)+#if __GLASGOW_HASKELL__ >= 710+ , pattern NonTermination_+#endif -- ** Nested Atomically , AsNestedAtomically(..)+#if __GLASGOW_HASKELL__ >= 710+ , pattern NestedAtomically_+#endif -- ** Blocked Indefinitely -- *** on MVar , AsBlockedIndefinitelyOnMVar(..)+#if __GLASGOW_HASKELL__ >= 710+ , pattern BlockedIndefinitelyOnMVar_+#endif -- *** on STM , AsBlockedIndefinitelyOnSTM(..)+#if __GLASGOW_HASKELL__ >= 710+ , pattern BlockedIndefinitelyOnSTM_+#endif -- ** Deadlock , AsDeadlock(..)+#if __GLASGOW_HASKELL__ >= 710+ , pattern Deadlock_+#endif -- ** No Such Method , AsNoMethodError(..)+#if __GLASGOW_HASKELL__ >= 710+ , pattern NoMethodError_+#endif -- ** Pattern Match Failure , AsPatternMatchFail(..)+#if __GLASGOW_HASKELL__ >= 710+ , pattern PatternMatchFail_+#endif -- ** Record , AsRecConError(..) , AsRecSelError(..) , AsRecUpdError(..)+#if __GLASGOW_HASKELL__ >= 710+ , pattern RecConError_+ , pattern RecSelError_+ , pattern RecUpdError_+#endif -- ** Error Call , AsErrorCall(..)+#if __GLASGOW_HASKELL__ >= 710+ , pattern ErrorCall_+#endif -- * Handling Exceptions , AsHandlingException(..)+#if __GLASGOW_HASKELL__ >= 710+ , pattern HandlingException_+#endif ) where import Control.Applicative@@ -117,6 +181,9 @@ ( const, either, flip, id , (.) , Maybe(..), Either(..), String+#if __GLASGOW_HASKELL__ >= 710+ , Bool(..)+#endif ) #ifdef HLINT@@ -142,6 +209,11 @@ exception = prism' toException fromException {-# INLINE exception #-} +#if __GLASGOW_HASKELL__ >= 710+pattern Exception e <- (preview exception -> Just e) where+ Exception e = review exception e+#endif+ ------------------------------------------------------------------------------ -- Catching ------------------------------------------------------------------------------@@ -385,6 +457,11 @@ _IOException = exception {-# INLINE _IOException #-} +#if __GLASGOW_HASKELL__ >= 710+pattern IOException_ a <- (preview _IOException -> Just a) where+ IOException_ a = review _IOException a+#endif+ ---------------------------------------------------------------------------- -- ArithException ----------------------------------------------------------------------------@@ -395,6 +472,11 @@ -- '_ArithException' :: 'Prism'' 'SomeException' 'ArithException' _ArithException :: Prism' t ArithException +#if __GLASGOW_HASKELL__ >= 710+pattern ArithException_ a <- (preview _ArithException -> Just a) where+ ArithException_ a = review _ArithException a+#endif+ instance AsArithException ArithException where _ArithException = id {-# INLINE _ArithException #-}@@ -419,6 +501,11 @@ seta t = Left (pure t) {-# INLINE _Overflow #-} +#if __GLASGOW_HASKELL__ >= 710+pattern Overflow_ <- (has _Overflow -> True) where+ Overflow_ = review _Overflow ()+#endif+ -- | Handle arithmetic '_Underflow'. -- -- @@@ -435,6 +522,11 @@ seta t = Left (pure t) {-# INLINE _Underflow #-} +#if __GLASGOW_HASKELL__ >= 710+pattern Underflow_ <- (has _Underflow -> True) where+ Underflow_ = review _Underflow ()+#endif+ -- | Handle arithmetic loss of precision. -- -- @@@ -451,6 +543,11 @@ seta t = Left (pure t) {-# INLINE _LossOfPrecision #-} +#if __GLASGOW_HASKELL__ >= 710+pattern LossOfPrecision_ <- (has _LossOfPrecision -> True) where+ LossOfPrecision_ = review _LossOfPrecision ()+#endif+ -- | Handle division by zero. -- -- @@@ -467,6 +564,11 @@ seta t = Left (pure t) {-# INLINE _DivideByZero #-} +#if __GLASGOW_HASKELL__ >= 710+pattern DivideByZero_ <- (has _DivideByZero -> True) where+ DivideByZero_ = review _DivideByZero ()+#endif+ -- | Handle exceptional _Denormalized floating pure. -- -- @@@ -483,6 +585,11 @@ seta t = Left (pure t) {-# INLINE _Denormal #-} +#if __GLASGOW_HASKELL__ >= 710+pattern Denormal_ <- (has _Denormal -> True) where+ Denormal_ = review _Denormal ()+#endif+ #if MIN_VERSION_base(4,6,0) -- | Added in @base@ 4.6 in response to this libraries discussion: --@@ -502,8 +609,13 @@ seta t = Left (pure t) {-# INLINE _RatioZeroDenominator #-} +#if __GLASGOW_HASKELL__ >= 710+pattern RatioZeroDenominator_ <- (has _RatioZeroDenominator -> True) where+ RatioZeroDenominator_ = review _RatioZeroDenominator () #endif +#endif+ ---------------------------------------------------------------------------- -- ArrayException ----------------------------------------------------------------------------@@ -526,6 +638,11 @@ _ArrayException = exception {-# INLINE _ArrayException #-} +#if __GLASGOW_HASKELL__ >= 710+pattern ArrayException_ e <- (preview _ArrayException -> Just e) where+ ArrayException_ e = review _ArrayException e+#endif+ -- | An attempt was made to index an array outside its declared bounds. -- -- @@@ -542,6 +659,11 @@ seta t = Left (pure t) {-# INLINE _IndexOutOfBounds #-} +#if __GLASGOW_HASKELL__ >= 710+pattern IndexOutOfBounds_ e <- (preview _IndexOutOfBounds -> Just e) where+ IndexOutOfBounds_ e = review _IndexOutOfBounds e+#endif+ -- | An attempt was made to evaluate an element of an array that had not been initialized. -- -- @@@ -558,6 +680,11 @@ seta t = Left (pure t) {-# INLINE _UndefinedElement #-} +#if __GLASGOW_HASKELL__ >= 710+pattern UndefinedElement_ e <- (preview _UndefinedElement -> Just e) where+ UndefinedElement_ e = review _UndefinedElement e+#endif+ ---------------------------------------------------------------------------- -- AssertionFailed ----------------------------------------------------------------------------@@ -583,6 +710,11 @@ _AssertionFailed = exception._Wrapping AssertionFailed {-# INLINE _AssertionFailed #-} +#if __GLASGOW_HASKELL__ >= 710+pattern AssertionFailed_ e <- (preview _AssertionFailed -> Just e) where+ AssertionFailed_ e = review _AssertionFailed e+#endif+ ---------------------------------------------------------------------------- -- AsyncException ----------------------------------------------------------------------------@@ -605,6 +737,11 @@ _AsyncException = exception {-# INLINE _AsyncException #-} +#if __GLASGOW_HASKELL__ >= 710+pattern AsyncException_ e <- (preview _AsyncException -> Just e) where+ AsyncException_ e = review _AsyncException e+#endif+ -- | The current thread's stack exceeded its limit. Since an 'Exception' has -- been raised, the thread's stack will certainly be below its limit again, -- but the programmer should take remedial action immediately.@@ -619,6 +756,11 @@ seta t = Left (pure t) {-# INLINE _StackOverflow #-} +#if __GLASGOW_HASKELL__ >= 710+pattern StackOverflow_ <- (has _StackOverflow -> True) where+ StackOverflow_ = review _StackOverflow ()+#endif+ -- | The program's heap is reaching its limit, and the program should take action -- to reduce the amount of live data it has. --@@ -638,6 +780,11 @@ seta t = Left (pure t) {-# INLINE _HeapOverflow #-} +#if __GLASGOW_HASKELL__ >= 710+pattern HeapOverflow_ <- (has _HeapOverflow -> True) where+ HeapOverflow_ = review _HeapOverflow ()+#endif+ -- | This 'Exception' is raised by another thread calling -- 'Control.Concurrent.killThread', or by the system if it needs to terminate -- the thread for some reason.@@ -652,6 +799,11 @@ seta t = Left (pure t) {-# INLINE _ThreadKilled #-} +#if __GLASGOW_HASKELL__ >= 710+pattern ThreadKilled_ <- (has _ThreadKilled -> True) where+ ThreadKilled_ = review _ThreadKilled ()+#endif+ -- | This 'Exception' is raised by default in the main thread of the program when -- the user requests to terminate the program via the usual mechanism(s) -- (/e.g./ Control-C in the console).@@ -666,6 +818,11 @@ seta t = Left (pure t) {-# INLINE _UserInterrupt #-} +#if __GLASGOW_HASKELL__ >= 710+pattern UserInterrupt_ <- (has _UserInterrupt -> True) where+ UserInterrupt_ = review _UserInterrupt ()+#endif+ ---------------------------------------------------------------------------- -- AsyncException ----------------------------------------------------------------------------@@ -690,6 +847,11 @@ _NonTermination = exception.trivial NonTermination {-# INLINE _NonTermination #-} +#if __GLASGOW_HASKELL__ >= 710+pattern NonTermination_ <- (has _NonTermination -> True) where+ NonTermination_ = review _NonTermination ()+#endif+ ---------------------------------------------------------------------------- -- NestedAtomically ----------------------------------------------------------------------------@@ -713,6 +875,11 @@ _NestedAtomically = exception.trivial NestedAtomically {-# INLINE _NestedAtomically #-} +#if __GLASGOW_HASKELL__ >= 710+pattern NestedAtomically_ <- (has _NestedAtomically -> True) where+ NestedAtomically_ = review _NestedAtomically ()+#endif+ ---------------------------------------------------------------------------- -- BlockedIndefinitelyOnMVar ----------------------------------------------------------------------------@@ -737,6 +904,11 @@ _BlockedIndefinitelyOnMVar = exception.trivial BlockedIndefinitelyOnMVar {-# INLINE _BlockedIndefinitelyOnMVar #-} +#if __GLASGOW_HASKELL__ >= 710+pattern BlockedIndefinitelyOnMVar_ <- (has _BlockedIndefinitelyOnMVar -> True) where+ BlockedIndefinitelyOnMVar_ = review _BlockedIndefinitelyOnMVar ()+#endif+ ---------------------------------------------------------------------------- -- BlockedIndefinitelyOnSTM ----------------------------------------------------------------------------@@ -761,6 +933,11 @@ _BlockedIndefinitelyOnSTM = exception.trivial BlockedIndefinitelyOnSTM {-# INLINE _BlockedIndefinitelyOnSTM #-} +#if __GLASGOW_HASKELL__ >= 710+pattern BlockedIndefinitelyOnSTM_ <- (has _BlockedIndefinitelyOnSTM -> True) where+ BlockedIndefinitelyOnSTM_ = review _BlockedIndefinitelyOnSTM ()+#endif+ ---------------------------------------------------------------------------- -- Deadlock ----------------------------------------------------------------------------@@ -784,6 +961,11 @@ _Deadlock = exception.trivial Deadlock {-# INLINE _Deadlock #-} +#if __GLASGOW_HASKELL__ >= 710+pattern Deadlock_ <- (has _Deadlock -> True) where+ Deadlock_ = review _Deadlock ()+#endif+ ---------------------------------------------------------------------------- -- NoMethodError ----------------------------------------------------------------------------@@ -807,6 +989,11 @@ _NoMethodError = exception._Wrapping NoMethodError {-# INLINE _NoMethodError #-} +#if __GLASGOW_HASKELL__ >= 710+pattern NoMethodError_ e <- (preview _NoMethodError -> Just e) where+ NoMethodError_ e = review _NoMethodError e+#endif+ ---------------------------------------------------------------------------- -- PatternMatchFail ----------------------------------------------------------------------------@@ -829,6 +1016,11 @@ _PatternMatchFail = exception._Wrapping PatternMatchFail {-# INLINE _PatternMatchFail #-} +#if __GLASGOW_HASKELL__ >= 710+pattern PatternMatchFail_ e <- (preview _PatternMatchFail -> Just e) where+ PatternMatchFail_ e = review _PatternMatchFail e+#endif+ ---------------------------------------------------------------------------- -- RecConError ----------------------------------------------------------------------------@@ -852,6 +1044,11 @@ _RecConError = exception._Wrapping RecConError {-# INLINE _RecConError #-} +#if __GLASGOW_HASKELL__ >= 710+pattern RecConError_ e <- (preview _RecConError -> Just e) where+ RecConError_ e = review _RecConError e+#endif+ ---------------------------------------------------------------------------- -- RecSelError ----------------------------------------------------------------------------@@ -871,6 +1068,11 @@ _RecSelError = exception._Wrapping RecSelError {-# INLINE _RecSelError #-} +#if __GLASGOW_HASKELL__ >= 710+pattern RecSelError_ e <- (preview _RecSelError -> Just e) where+ RecSelError_ e = review _RecSelError e+#endif+ ---------------------------------------------------------------------------- -- RecUpdError ----------------------------------------------------------------------------@@ -890,6 +1092,11 @@ _RecUpdError = exception._Wrapping RecUpdError {-# INLINE _RecUpdError #-} +#if __GLASGOW_HASKELL__ >= 710+pattern RecUpdError_ e <- (preview _RecUpdError -> Just e) where+ RecUpdError_ e = review _RecUpdError e+#endif+ ---------------------------------------------------------------------------- -- ErrorCall ----------------------------------------------------------------------------@@ -912,6 +1119,11 @@ _ErrorCall = exception._Wrapping ErrorCall {-# INLINE _ErrorCall #-} +#if __GLASGOW_HASKELL__ >= 710+pattern ErrorCall_ e <- (preview _ErrorCall -> Just e) where+ ErrorCall_ e = review _ErrorCall e+#endif+ ------------------------------------------------------------------------------ -- HandlingException ------------------------------------------------------------------------------@@ -934,6 +1146,11 @@ instance AsHandlingException SomeException where _HandlingException = exception.trivial HandlingException {-# INLINE _HandlingException #-}++#if __GLASGOW_HASKELL__ >= 710+pattern HandlingException_ <- (has _HandlingException -> True) where+ HandlingException_ = review _HandlingException ()+#endif ------------------------------------------------------------------------------ -- Helper Functions
src/Control/Lens/Cons.hs view
@@ -7,6 +7,10 @@ #ifdef TRUSTWORTHY {-# LANGUAGE Trustworthy #-} #endif+#if __GLASGOW_HASKELL__ >= 710+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE ViewPatterns #-}+#endif ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Cons@@ -25,12 +29,19 @@ , cons , uncons , _head, _tail+#if __GLASGOW_HASKELL__ >= 710+ , pattern (:>)+#endif -- * Snoc , Snoc(..) , (|>) , snoc , unsnoc , _init, _last+#if __GLASGOW_HASKELL__ >= 710+ , pattern (:<)+#endif+ ) where import Control.Lens.Equality (simply)@@ -45,7 +56,7 @@ import qualified Data.List.NonEmpty as NonEmpty import Data.Monoid import qualified Data.Sequence as Seq-import Data.Sequence hiding ((<|), (|>))+import Data.Sequence hiding ((<|), (|>), (:<), (:>)) import qualified Data.Text as StrictT import qualified Data.Text.Lazy as LazyT import Data.Vector (Vector)@@ -72,6 +83,19 @@ infixr 5 <|, `cons` infixl 5 |>, `snoc` +#if __GLASGOW_HASKELL__ >= 710++pattern (:<) a s <- (preview _Cons -> Just (a,s)) where+ (:<) a s = _Cons # (a,s)++infixr 5 :<+infixl 5 :>++pattern (:>) s a <- (preview _Snoc -> Just (s,a)) where+ (:>) a s = _Snoc # (a,s)++#endif+ ------------------------------------------------------------------------------ -- Cons ------------------------------------------------------------------------------@@ -105,7 +129,7 @@ instance Cons (Seq a) (Seq b) a b where _Cons = prism (uncurry (Seq.<|)) $ \aas -> case viewl aas of- a :< as -> Right (a, as)+ a Seq.:< as -> Right (a, as) EmptyL -> Left mempty {-# INLINE _Cons #-} @@ -336,7 +360,7 @@ instance Snoc (Seq a) (Seq b) a b where _Snoc = prism (uncurry (Seq.|>)) $ \aas -> case viewr aas of- as :> a -> Right (as, a)+ as Seq.:> a -> Right (as, a) EmptyR -> Left mempty {-# INLINE _Snoc #-}
src/Control/Lens/Empty.hs view
@@ -1,10 +1,16 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE DefaultSignatures #-}+ #ifdef TRUSTWORTHY {-# LANGUAGE Trustworthy #-} #endif +#if __GLASGOW_HASKELL__ >= 710+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE ViewPatterns #-}+#endif+ ------------------------------------------------------------------------------- -- | -- Module : Control.Lens.Empty@@ -18,9 +24,15 @@ module Control.Lens.Empty ( AsEmpty(..)+#if __GLASGOW_HASKELL__ >= 710+ , pattern Empty+#endif ) where import Control.Lens.Iso+#if __GLASGOW_HASKELL__ >= 710+import Control.Lens.Fold+#endif import Control.Lens.Prism import Control.Lens.Review import Data.ByteString as StrictB@@ -55,6 +67,11 @@ default _Empty :: (Monoid a, Eq a) => Prism' a () _Empty = only mempty {-# INLINE _Empty #-}+#endif++#if __GLASGOW_HASKELL__ >= 710+pattern Empty <- (has _Empty -> True) where+ Empty = review _Empty () #endif {- Default Monoid instances -}
src/Control/Lens/Fold.hs view
@@ -8,6 +8,10 @@ #define MIN_VERSION_profunctors(x,y,z) 1 #endif +#ifndef MIN_VERSION_reflection+#define MIN_VERSION_reflection(x,y,z) 1+#endif+ #if __GLASGOW_HASKELL__ < 708 || !(MIN_VERSION_profunctors(4,4,0)) {-# LANGUAGE Trustworthy #-} #endif@@ -160,6 +164,7 @@ import Data.Foldable import Data.Functor.Apply import Data.Functor.Compose+import Data.Functor.Contravariant import Data.Int (Int64) import Data.List (intercalate) import Data.Maybe@@ -168,6 +173,9 @@ import Data.Profunctor.Rep import Data.Profunctor.Sieve import Data.Profunctor.Unsafe+#if MIN_VERSION_reflection(2,1,0)+import Data.Reflection+#endif import Data.Traversable import Prelude hiding (foldr) @@ -206,11 +214,11 @@ -- >>> [1,2,3,4]^..folding tail -- [2,3,4] folding :: Foldable f => (s -> f a) -> Fold s a-folding sfa agb = coerce . traverse_ agb . sfa+folding sfa agb = phantom . traverse_ agb . sfa {-# INLINE folding #-} ifolding :: (Foldable f, Indexable i p, Contravariant g, Applicative g) => (s -> f (i, a)) -> Over p g s t a b-ifolding sfa f = coerce . traverse_ (coerce . uncurry (indexed f)) . sfa+ifolding sfa f = phantom . traverse_ (phantom . uncurry (indexed f)) . sfa {-# INLINE ifolding #-} -- | Obtain a 'Fold' by lifting 'foldr' like function.@@ -218,12 +226,12 @@ -- >>> [1,2,3,4]^..foldring foldr -- [1,2,3,4] foldring :: (Contravariant f, Applicative f) => ((a -> f a -> f a) -> f a -> s -> f a) -> LensLike f s t a b-foldring fr f = coerce . fr (\a fa -> f a *> fa) noEffect+foldring fr f = phantom . fr (\a fa -> f a *> fa) noEffect {-# INLINE foldring #-} -- | Obtain 'FoldWithIndex' by lifting 'ifoldr' like function. ifoldring :: (Indexable i p, Contravariant f, Applicative f) => ((i -> a -> f a -> f a) -> f a -> s -> f a) -> Over p f s t a b-ifoldring ifr f = coerce . ifr (\i a fa -> indexed f i a *> fa) noEffect+ifoldring ifr f = phantom . ifr (\i a fa -> indexed f i a *> fa) noEffect {-# INLINE ifoldring #-} -- | Obtain a 'Fold' from any 'Foldable' indexed by ordinal position.@@ -497,7 +505,7 @@ -- @ -- 'foldMapOf' :: 'Getting' r s a -> (a -> r) -> s -> r -- @-foldMapOf :: Profunctor p => Accessing p r s a -> p a r -> s -> r+foldMapOf :: Getting r s a -> (a -> r) -> s -> r foldMapOf l f = getConst #. l (Const #. f) {-# INLINE foldMapOf #-} @@ -549,8 +557,8 @@ -- @ -- 'foldrOf' :: 'Getting' ('Endo' r) s a -> (a -> r -> r) -> r -> s -> r -- @-foldrOf :: Profunctor p => Accessing p (Endo r) s a -> p a (r -> r) -> r -> s -> r-foldrOf l f z = flip appEndo z `rmap` foldMapOf l (Endo #. f)+foldrOf :: Getting (Endo r) s a -> (a -> r -> r) -> r -> s -> r+foldrOf l f z = flip appEndo z . foldMapOf l (Endo #. f) {-# INLINE foldrOf #-} -- | Left-associative fold of the parts of a structure that are viewed through a 'Lens', 'Getter', 'Fold' or 'Traversal'.@@ -692,7 +700,7 @@ -- 'anyOf' :: 'Traversal'' s a -> (a -> 'Bool') -> s -> 'Bool' -- 'anyOf' :: 'Prism'' s a -> (a -> 'Bool') -> s -> 'Bool' -- @-anyOf :: Profunctor p => Accessing p Any s a -> p a Bool -> s -> Bool+anyOf :: Getting Any s a -> (a -> Bool) -> s -> Bool anyOf l f = getAny #. foldMapOf l (Any #. f) {-# INLINE anyOf #-} @@ -719,7 +727,7 @@ -- 'allOf' :: 'Traversal'' s a -> (a -> 'Bool') -> s -> 'Bool' -- 'allOf' :: 'Prism'' s a -> (a -> 'Bool') -> s -> 'Bool' -- @-allOf :: Profunctor p => Accessing p All s a -> p a Bool -> s -> Bool+allOf :: Getting All s a -> (a -> Bool) -> s -> Bool allOf l f = getAll #. foldMapOf l (All #. f) {-# INLINE allOf #-} @@ -742,7 +750,7 @@ -- 'noneOf' :: 'Traversal'' s a -> (a -> 'Bool') -> s -> 'Bool' -- 'noneOf' :: 'Prism'' s a -> (a -> 'Bool') -> s -> 'Bool' -- @-noneOf :: Profunctor p => Accessing p Any s a -> p a Bool -> s -> Bool+noneOf :: Getting Any s a -> (a -> Bool) -> s -> Bool noneOf l f = not . anyOf l f {-# INLINE noneOf #-} @@ -842,7 +850,7 @@ -- 'traverseOf_' :: 'Applicative' f => 'Traversal'' s a -> (a -> f r) -> s -> f () -- 'traverseOf_' :: 'Applicative' f => 'Prism'' s a -> (a -> f r) -> s -> f () -- @-traverseOf_ :: (Profunctor p, Functor f) => Accessing p (Traversed r f) s a -> p a (f r) -> s -> f ()+traverseOf_ :: Functor f => Getting (Traversed r f) s a -> (a -> f r) -> s -> f () traverseOf_ l f = void . getTraversed #. foldMapOf l (Traversed #. f) {-# INLINE traverseOf_ #-} @@ -875,7 +883,7 @@ -- 'forOf_' :: 'Applicative' f => 'Traversal'' s a -> s -> (a -> f r) -> f () -- 'forOf_' :: 'Applicative' f => 'Prism'' s a -> s -> (a -> f r) -> f () -- @-forOf_ :: (Profunctor p, Functor f) => Accessing p (Traversed r f) s a -> s -> p a (f r) -> f ()+forOf_ :: Functor f => Getting (Traversed r f) s a -> s -> (a -> f r) -> f () forOf_ = flip . traverseOf_ {-# INLINE forOf_ #-} @@ -919,7 +927,7 @@ -- 'mapMOf_' :: 'Monad' m => 'Traversal'' s a -> (a -> m r) -> s -> m () -- 'mapMOf_' :: 'Monad' m => 'Prism'' s a -> (a -> m r) -> s -> m () -- @-mapMOf_ :: (Profunctor p, Monad m) => Accessing p (Sequenced r m) s a -> p a (m r) -> s -> m ()+mapMOf_ :: Monad m => Getting (Sequenced r m) s a -> (a -> m r) -> s -> m () mapMOf_ l f = liftM skip . getSequenced #. foldMapOf l (Sequenced #. f) {-# INLINE mapMOf_ #-} @@ -941,7 +949,7 @@ -- 'forMOf_' :: 'Monad' m => 'Traversal'' s a -> s -> (a -> m r) -> m () -- 'forMOf_' :: 'Monad' m => 'Prism'' s a -> s -> (a -> m r) -> m () -- @-forMOf_ :: (Profunctor p, Monad m) => Accessing p (Sequenced r m) s a -> s -> p a (m r) -> m ()+forMOf_ :: Monad m => Getting (Sequenced r m) s a -> s -> (a -> m r) -> m () forMOf_ = flip . mapMOf_ {-# INLINE forMOf_ #-} @@ -1076,7 +1084,7 @@ -- 'concatMapOf' :: 'Iso'' s a -> (a -> [r]) -> s -> [r] -- 'concatMapOf' :: 'Traversal'' s a -> (a -> [r]) -> s -> [r] -- @-concatMapOf :: Profunctor p => Accessing p [r] s a -> p a [r] -> s -> [r]+concatMapOf :: Getting [r] s a -> (a -> [r]) -> s -> [r] concatMapOf l ces = getConst #. l (Const #. ces) {-# INLINE concatMapOf #-} @@ -1466,8 +1474,8 @@ -- 'findOf' :: 'Getting' ('Endo' ('Maybe' a)) s a -> (a -> 'Bool') -> s -> 'Maybe' a -- 'findOf' l p = 'foldrOf' l (\a y -> if p a then 'Just' a else y) 'Nothing' -- @-findOf :: Conjoined p => Accessing p (Endo (Maybe a)) s a -> p a Bool -> s -> Maybe a-findOf l p = foldrOf l (cotabulate $ \wa y -> if cosieve p wa then Just (extract wa) else y) Nothing+findOf :: Getting (Endo (Maybe a)) s a -> (a -> Bool) -> s -> Maybe a+findOf l f = foldrOf l (\a y -> if f a then Just a else y) Nothing {-# INLINE findOf #-} -- | The 'findMOf' function takes a 'Lens' (or 'Getter', 'Iso', 'Fold', or 'Traversal'),@@ -1506,8 +1514,8 @@ -- 'findMOf' :: Monad m => 'Getting' ('Endo' (m ('Maybe' a))) s a -> (a -> m 'Bool') -> s -> m ('Maybe' a) -- 'findMOf' l p = 'foldrOf' l (\a y -> p a >>= \x -> if x then return ('Just' a) else y) $ return 'Nothing' -- @-findMOf :: (Monad m, Conjoined p) => Accessing p (Endo (m (Maybe a))) s a -> p a (m Bool) -> s -> m (Maybe a)-findMOf l p = foldrOf l (cotabulate $ \wa y -> cosieve p wa >>= \r -> if r then return (Just (extract wa)) else y) $ return Nothing+findMOf :: Monad m => Getting (Endo (m (Maybe a))) s a -> (a -> m Bool) -> s -> m (Maybe a)+findMOf l f = foldrOf l (\a y -> f a >>= \r -> if r then return (Just a) else y) $ return Nothing {-# INLINE findMOf #-} -- | A variant of 'foldrOf' that has no base case and thus may only be applied@@ -1738,7 +1746,7 @@ -- 'pre' :: 'Prism'' s a -> 'IndexPreservingGetter' s ('Maybe' a) -- @ pre :: Getting (First a) s a -> IndexPreservingGetter s (Maybe a)-pre l = dimap (getFirst . getConst #. l (Const #. First #. Just)) coerce+pre l = dimap (getFirst . getConst #. l (Const #. First #. Just)) phantom {-# INLINE pre #-} -- | This converts an 'IndexedFold' to an 'IndexPreservingGetter' that returns the first index@@ -1751,7 +1759,7 @@ -- 'ipre' :: 'IndexedLens'' i s a -> 'IndexPreservingGetter' s ('Maybe' (i, a)) -- @ ipre :: IndexedGetting i (First (i, a)) s a -> IndexPreservingGetter s (Maybe (i, a))-ipre l = dimap (getFirst . getConst #. l (Indexed $ \i a -> Const (First (Just (i, a))))) coerce+ipre l = dimap (getFirst . getConst #. l (Indexed $ \i a -> Const (First (Just (i, a))))) phantom {-# INLINE ipre #-} ------------------------------------------------------------------------------@@ -2000,7 +2008,7 @@ -- @ -- ifoldMapOf :: IndexedGetting i m s a -> (i -> a -> m) -> s -> m-ifoldMapOf l = foldMapOf l .# Indexed+ifoldMapOf l f = getConst #. l (Const #. Indexed f) {-# INLINE ifoldMapOf #-} -- | Right-associative fold of parts of a structure that are viewed through an 'IndexedFold' or 'IndexedTraversal' with@@ -2019,7 +2027,7 @@ -- 'ifoldrOf' :: 'IndexedTraversal'' i s a -> (i -> a -> r -> r) -> r -> s -> r -- @ ifoldrOf :: IndexedGetting i (Endo r) s a -> (i -> a -> r -> r) -> r -> s -> r-ifoldrOf l = foldrOf l .# Indexed+ifoldrOf l f z = flip appEndo z . getConst #. l (Const #. Endo #. Indexed f) {-# INLINE ifoldrOf #-} -- | Left-associative fold of the parts of a structure that are viewed through an 'IndexedFold' or 'IndexedTraversal' with@@ -2057,7 +2065,7 @@ -- 'ianyOf' :: 'IndexedTraversal'' i s a -> (i -> a -> 'Bool') -> s -> 'Bool' -- @ ianyOf :: IndexedGetting i Any s a -> (i -> a -> Bool) -> s -> Bool-ianyOf l = anyOf l .# Indexed+ianyOf l f = getAny #. getConst #. l (Const #. Any #. Indexed f) {-# INLINE ianyOf #-} -- | Return whether or not all elements viewed through an 'IndexedFold' or 'IndexedTraversal'@@ -2076,7 +2084,7 @@ -- 'iallOf' :: 'IndexedTraversal'' i s a -> (i -> a -> 'Bool') -> s -> 'Bool' -- @ iallOf :: IndexedGetting i All s a -> (i -> a -> Bool) -> s -> Bool-iallOf l = allOf l .# Indexed+iallOf l f = getAll #. getConst #. l (Const #. All #. Indexed f) {-# INLINE iallOf #-} -- | Return whether or not none of the elements viewed through an 'IndexedFold' or 'IndexedTraversal'@@ -2095,7 +2103,7 @@ -- 'inoneOf' :: 'IndexedTraversal'' i s a -> (i -> a -> 'Bool') -> s -> 'Bool' -- @ inoneOf :: IndexedGetting i Any s a -> (i -> a -> Bool) -> s -> Bool-inoneOf l = noneOf l .# Indexed+inoneOf l f = not . ianyOf l f {-# INLINE inoneOf #-} -- | Traverse the targets of an 'IndexedFold' or 'IndexedTraversal' with access to the @i@, discarding the results.@@ -2113,7 +2121,7 @@ -- 'itraverseOf_' :: 'Applicative' f => 'IndexedTraversal'' i s a -> (i -> a -> f r) -> s -> f () -- @ itraverseOf_ :: Functor f => IndexedGetting i (Traversed r f) s a -> (i -> a -> f r) -> s -> f ()-itraverseOf_ l = traverseOf_ l .# Indexed+itraverseOf_ l f = void . getTraversed #. getConst #. l (Const #. Traversed #. Indexed f) {-# INLINE itraverseOf_ #-} -- | Traverse the targets of an 'IndexedFold' or 'IndexedTraversal' with access to the index, discarding the results@@ -2155,7 +2163,7 @@ -- 'imapMOf_' :: 'Monad' m => 'IndexedTraversal'' i s a -> (i -> a -> m r) -> s -> m () -- @ imapMOf_ :: Monad m => IndexedGetting i (Sequenced r m) s a -> (i -> a -> m r) -> s -> m ()-imapMOf_ l = mapMOf_ l .# Indexed+imapMOf_ l f = liftM skip . getSequenced #. getConst #. l (Const #. Sequenced #. Indexed f) {-# INLINE imapMOf_ #-} -- | Run monadic actions for each target of an 'IndexedFold' or 'IndexedTraversal' with access to the index,@@ -2218,7 +2226,7 @@ -- 'ifindOf' :: 'IndexedTraversal'' i s a -> (i -> a -> 'Bool') -> s -> 'Maybe' a -- @ ifindOf :: IndexedGetting i (Endo (Maybe a)) s a -> (i -> a -> Bool) -> s -> Maybe a-ifindOf l = findOf l .# Indexed+ifindOf l f = ifoldrOf l (\i a y -> if f i a then Just a else y) Nothing {-# INLINE ifindOf #-} -- | The 'ifindMOf' function takes an 'IndexedFold' or 'IndexedTraversal', a monadic predicate that is also@@ -2238,7 +2246,7 @@ -- 'ifindMOf' :: 'Monad' m => 'IndexedTraversal'' i s a -> (i -> a -> m 'Bool') -> s -> m ('Maybe' a) -- @ ifindMOf :: Monad m => IndexedGetting i (Endo (m (Maybe a))) s a -> (i -> a -> m Bool) -> s -> m (Maybe a)-ifindMOf l = findMOf l .# Indexed+ifindMOf l f = ifoldrOf l (\i a y -> f i a >>= \r -> if r then return (Just a) else y) $ return Nothing {-# INLINE ifindMOf #-} -- | /Strictly/ fold right over the elements of a structure with an index.@@ -2499,19 +2507,6 @@ -- Folds with Reified Monoid ------------------------------------------------------------------------------ --- | Fold a value using its 'Foldable' instance using--- explicitly provided 'Monoid' operations. This is like 'fold'--- where the 'Monoid' instance can be manually specified.------ @--- 'foldBy' 'mappend' 'mempty' ≡ 'fold'--- @------ >>> foldBy (++) [] ["hello","world"]--- "helloworld"-foldBy :: Foldable t => (a -> a -> a) -> a -> t a -> a-foldBy f z = reifyFold f z (foldMap M)- -- | Fold a value using a specified 'Fold' and 'Monoid' operations. -- This is like 'foldBy' where the 'Foldable' instance can be -- manually specified.@@ -2531,20 +2526,7 @@ -- >>> foldByOf both (++) [] ("hello","world") -- "helloworld" foldByOf :: Fold s a -> (a -> a -> a) -> a -> s -> a-foldByOf l f z = reifyFold f z (foldMapOf l M)---- | Fold a value using its 'Foldable' instance using--- explicitly provided 'Monoid' operations. This is like 'foldMap'--- where the 'Monoid' instance can be manually specified.------ @--- 'foldMapBy' 'mappend' 'mempty' ≡ 'foldMap'--- @------ >>> foldMapBy (+) 0 length ["hello","world"]--- 10-foldMapBy :: Foldable t => (r -> r -> r) -> r -> (a -> r) -> t a -> r-foldMapBy f z g = reifyFold f z (foldMap (M #. g))+foldByOf l f z = reifyMonoid f z (foldMapOf l ReflectedMonoid) -- | Fold a value using a specified 'Fold' and 'Monoid' operations. -- This is like 'foldMapBy' where the 'Foldable' instance can be@@ -2565,4 +2547,4 @@ -- >>> foldMapByOf both (+) 0 length ("hello","world") -- 10 foldMapByOf :: Fold s a -> (r -> r -> r) -> r -> (a -> r) -> s -> r-foldMapByOf l f z g = reifyFold f z (foldMapOf l (M #. g))+foldMapByOf l f z g = reifyMonoid f z (foldMapOf l (ReflectedMonoid #. g))
src/Control/Lens/Getter.hs view
@@ -73,12 +73,11 @@ , ilistening, ilistenings -- * Implementation Details , Contravariant(..)- , coerce, coerced+ , getting , Const(..) ) where import Control.Applicative-import Control.Lens.Internal.Getter import Control.Lens.Internal.Indexed import Control.Lens.Type import Control.Monad.Reader.Class as Reader@@ -281,7 +280,7 @@ -- @ -- 'views' :: 'MonadReader' s m => 'Getting' r s a -> (a -> r) -> m r -- @-views :: (Profunctor p, MonadReader s m) => Over' p (Const r) s a -> p a r -> m r+views :: MonadReader s m => LensLike' (Const r) s a -> (a -> r) -> m r views l f = Reader.asks (getConst #. l (Const #. f)) {-# INLINE views #-} @@ -360,7 +359,7 @@ -- @ -- 'uses' :: 'MonadState' s m => 'Getting' r s t a b -> (a -> r) -> m r -- @-uses :: (Profunctor p, MonadState s m) => Over' p (Const r) s a -> p a r -> m r+uses :: MonadState s m => LensLike' (Const r) s a -> (a -> r) -> m r uses l f = State.gets (views l f) {-# INLINE uses #-} @@ -456,7 +455,7 @@ -- 'iviews' ≡ 'Control.Lens.Fold.ifoldMapOf' -- @ iviews :: MonadReader s m => IndexedGetting i r s a -> (i -> a -> r) -> m r-iviews l = views l .# Indexed+iviews l f = asks (getConst #. l (Const #. Indexed f)) {-# INLINE iviews #-} -- | Use the index and value of an 'IndexedGetter' into the current state as a pair.@@ -471,7 +470,7 @@ -- -- When applied to an 'IndexedFold' the result will be a monoidal summary instead of a single answer. iuses :: MonadState s m => IndexedGetting i r s a -> (i -> a -> r) -> m r-iuses l = uses l .# Indexed+iuses l f = gets (getConst #. l (Const #. Indexed f)) {-# INLINE iuses #-} -- | View the index and value of an 'IndexedGetter' or 'IndexedLens'.@@ -494,5 +493,5 @@ -- | Coerce a 'Getter'-compatible 'LensLike' to a 'LensLike''. This -- is useful when using a 'Traversal' that is not simple as a 'Getter' or a -- 'Fold'.-coerced :: (Functor f, Contravariant f) => LensLike f s t a b -> LensLike' f s a-coerced l f = coerce . l (coerce . f)+getting :: (Functor f, Contravariant f) => LensLike f s t a b -> LensLike' f s a+getting l f = phantom . l (phantom . f)
src/Control/Lens/Indexed.hs view
@@ -76,6 +76,9 @@ -- * Indexed Folds with Reified Monoid , ifoldMapBy , ifoldMapByOf+ -- * Indexed Traversals with Reified Applicative+ , itraverseBy+ , itraverseByOf ) where import Control.Applicative@@ -100,6 +103,7 @@ import qualified Data.Array as Array import Data.Foldable import Data.Functor.Compose+import Data.Functor.Contravariant import Data.Functor.Product import Data.Functor.Reverse import Data.Hashable@@ -110,6 +114,7 @@ import Data.Map as Map import Data.Monoid hiding (Product) import Data.Profunctor.Unsafe+import Data.Reflection import Data.Sequence hiding ((:<), index) #if !(MIN_VERSION_containers(0,5,0)) import Data.Traversable (sequenceA)@@ -267,7 +272,7 @@ -- >>> Data.Map.fromList [(2, "hello"), (1, "world")]^..ifolded.asIndex -- [1,2] ifolded :: IndexedFold i (f a) a- ifolded = conjoined folded $ \f -> coerce . getFolding . ifoldMap (\i -> Folding #. indexed f i)+ ifolded = conjoined folded $ \f -> phantom . getFolding . ifoldMap (\i -> Folding #. indexed f i) {-# INLINE ifolded #-} -- | Right-associative fold of an indexed container with access to the index @i@.@@ -858,7 +863,13 @@ ------------------------------------------------------------------------------- ifoldMapBy :: FoldableWithIndex i t => (r -> r -> r) -> r -> (i -> a -> r) -> t a -> r-ifoldMapBy f z g = reifyFold f z (ifoldMap (\i a -> M (g i a)))+ifoldMapBy f z g = reifyMonoid f z (ifoldMap (\i a -> ReflectedMonoid (g i a))) -ifoldMapByOf :: (forall s. IndexedGetting i (M r s) t a) -> (r -> r -> r) -> r -> (i -> a -> r) -> t -> r-ifoldMapByOf l f z g = reifyFold f z (ifoldMapOf l (\i a -> M (g i a)))+ifoldMapByOf :: IndexedFold i t a -> (r -> r -> r) -> r -> (i -> a -> r) -> t -> r+ifoldMapByOf l f z g = reifyMonoid f z (ifoldMapOf l (\i a -> ReflectedMonoid (g i a)))++itraverseBy :: TraversableWithIndex i t => (forall x. x -> f x) -> (forall x y. f (x -> y) -> f x -> f y) -> (i -> a -> f b) -> t a -> f (t b)+itraverseBy pur app f = reifyApplicative pur app (itraverse (\i a -> ReflectedApplicative (f i a)))++itraverseByOf :: IndexedTraversal i s t a b -> (forall x. x -> f x) -> (forall x y. f (x -> y) -> f x -> f y) -> (i -> a -> f b) -> s -> f t+itraverseByOf l pur app f = reifyApplicative pur app (itraverseOf l (\i a -> ReflectedApplicative (f i a)))
src/Control/Lens/Internal/FieldTH.hs view
@@ -419,7 +419,7 @@ fxs = [ appE (varE f) (varE x) | x <- xs ] body = foldl (\a b -> appsE [varE apValName, a, b])- (appE (varE coerceValName) (head fxs))+ (appE (varE phantomValName) (head fxs)) (tail fxs) -- clause f (Con x1..xn) = coerce (f x1) <*> ... <*> f xn
src/Control/Lens/Internal/Fold.hs view
@@ -26,8 +26,7 @@ , Min(..), getMin , Leftmost(..), getLeftmost , Rightmost(..), getRightmost- , ReifiedMonoid(..), M(..)- , reifyFold+ , ReifiedMonoid(..) ) where import Control.Applicative@@ -213,24 +212,3 @@ getRightmost RPure = Nothing getRightmost (RLeaf a) = Just a getRightmost (RStep x) = getRightmost x----------------------------------------------------------------------------------- Folding with Reified Monoid---------------------------------------------------------------------------------data ReifiedMonoid a = ReifiedMonoid { reifiedMappend :: a -> a -> a, reifiedMempty :: a }--instance Reifies s (ReifiedMonoid a) => Monoid (M a s) where- mappend (M x) (M y) = reflectResult (\m -> M (reifiedMappend m x y))- mempty = reflectResult (\m -> M (reifiedMempty m ))--reflectResult :: Reifies s a => (a -> f s) -> f s-reflectResult f = let r = f (reflect r) in r--newtype M a s = M a--unM :: M a s -> proxy s -> a-unM (M a) _ = a--reifyFold :: (a -> a -> a) -> a -> (forall s. Reifies s (ReifiedMonoid a) => t -> M a s) -> t -> a-reifyFold f z m xs = reify (ReifiedMonoid f z) (unM (m xs))
src/Control/Lens/Internal/Getter.hs view
@@ -13,9 +13,7 @@ -- ---------------------------------------------------------------------------- module Control.Lens.Internal.Getter- (- coerce- , noEffect+ ( noEffect , AlongsideLeft(..) , AlongsideRight(..) ) where@@ -29,23 +27,11 @@ import Data.Semigroup.Foldable import Data.Semigroup.Traversable import Data.Traversable-import Data.Void import Prelude --- | A 'Functor' you can 'coerce' ignores its argument, which it carries--- solely as a phantom type parameter.------ By the 'Functor' and 'Contravariant' laws, an instance of both will--- necessarily satisfy:------ @'id' = 'fmap' f = 'coerce' = 'contramap' g@-coerce :: (Contravariant f, Functor f) => f a -> f b-coerce a = absurd <$> contramap absurd a-{-# INLINE coerce #-}- -- | The 'mempty' equivalent for a 'Contravariant' 'Applicative' 'Functor'. noEffect :: (Contravariant f, Applicative f) => f a-noEffect = coerce $ pure ()+noEffect = phantom $ pure () {-# INLINE noEffect #-} newtype AlongsideLeft f b a = AlongsideLeft { getAlongsideLeft :: f (a, b) }
src/Control/Lens/Internal/Indexed.hs view
@@ -48,7 +48,6 @@ import Control.Category import Control.Comonad import Control.Lens.Internal.Instances ()-import qualified Control.Lens.Internal.Getter as Getter import Control.Monad import Control.Monad.Fix import Data.Distributive@@ -355,5 +354,5 @@ -- | When composed with an 'IndexedFold' or 'IndexedTraversal' this yields an -- ('Indexed') 'Fold' of the indices. asIndex :: (Indexable i p, Contravariant f, Functor f) => p i (f i) -> Indexed i s (f s)-asIndex f = Indexed $ \i _ -> Getter.coerce (indexed f i i)+asIndex f = Indexed $ \i _ -> phantom (indexed f i i) {-# INLINE asIndex #-}
src/Control/Lens/Internal/TH.hs view
@@ -30,6 +30,7 @@ ---------------------------------------------------------------------------- module Control.Lens.Internal.TH where +import Data.Functor.Contravariant import Language.Haskell.TH import Language.Haskell.TH.Syntax import qualified Data.Map as Map@@ -161,8 +162,12 @@ untoValName :: Name untoValName = mkLensName_v "Control.Lens.Review" "unto" -coerceValName :: Name-coerceValName = mkLensName_v "Control.Lens.Internal.Getter" "coerce"+phantomValName :: Name+phantomValName = mkLensName_v "Control.Lens.Internal.TH" "phantom2"++phantom2 :: (Functor f, Contravariant f) => f a -> f b+phantom2 = phantom+{-# INLINE phantom2 #-} composeValName :: Name composeValName = mkNameG_v "base" "GHC.Base" "."
src/Control/Lens/Iso.hs view
@@ -2,7 +2,13 @@ {-# LANGUAGE Rank2Types #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE ScopedTypeVariables #-} +#if __GLASGOW_HASKELL__ >= 710+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE ViewPatterns #-}+#endif+ #ifndef MIN_VERSION_bytestring #define MIN_VERSION_bytestring(x,y,z) 1 #endif@@ -48,10 +54,24 @@ , curried, uncurried , flipped , Swapped(..)+#if __GLASGOW_HASKELL__ >= 710+ , pattern Swapped+#endif , Strict(..)+#if __GLASGOW_HASKELL__ >= 710+ , pattern Strict+ , pattern Lazy+#endif , lazy- , Reversing(..), reversed+ , Reversing(..)+ , reversed+#if __GLASGOW_HASKELL__ >= 710+ , pattern Reversed+#endif , involuted+#if __GLASGOW_HASKELL__ >= 710+ , pattern List+#endif -- ** Uncommon Isomorphisms , magma , imagma@@ -65,11 +85,17 @@ , rmapping -- * Bifunctors , bimapping+#if __GLASGOW_HASKELL__ >= 710+ -- * Coercions+ , coerced+#endif ) where import Control.Lens.Equality (simple)+import Control.Lens.Getter import Control.Lens.Fold import Control.Lens.Internal.Context+import Control.Lens.Internal.Coerce import Control.Lens.Internal.Indexed import Control.Lens.Internal.Iso as Iso import Control.Lens.Internal.Magma@@ -84,7 +110,11 @@ import Control.Monad.RWS.Strict as Strict import Data.ByteString as StrictB hiding (reverse) import Data.ByteString.Lazy as LazyB hiding (reverse)-import Data.Functor.Contravariant++#if __GLASGOW_HASKELL__ >= 708+import Data.Coerce+#endif+ import Data.Functor.Identity import Data.Text as StrictT hiding (reverse) import Data.Text.Lazy as LazyT hiding (reverse)@@ -93,6 +123,10 @@ import Data.Profunctor import Data.Profunctor.Unsafe +#if __GLASGOW_HASKELL__ >= 710+import qualified GHC.Exts as Exts+#endif+ #ifdef HLINT {-# ANN module "HLint: ignore Use on" #-} #endif@@ -167,8 +201,14 @@ -- -- >>> au (_Wrapping Sum) foldMap [1,2,3,4] -- 10-au :: AnIso s t a b -> ((b -> t) -> e -> s) -> e -> a-au k = withIso k $ \ sa bt f e -> sa (f bt e)+--+-- You may want to think of this combinator as having the following, simpler type:+--+-- @+-- au :: AnIso s t a b -> ((b -> t) -> e -> s) -> e -> a+-- @+au :: Functor f => AnIso s t a b -> ((b -> t) -> f s) -> f a+au k = withIso k $ \ sa bt f -> fmap sa (f bt) {-# INLINE au #-} -- | Based on @ala'@ from Conor McBride's work on Epigram.@@ -177,13 +217,19 @@ -- -- For a version you pass the name of the @newtype@ constructor to, see 'Control.Lens.Wrapped.alaf'. ----- Mnemonically, the German /auf/ plays a similar role to /à la/, and the combinator--- is 'au' with an extra function argument.--- -- >>> auf (_Unwrapping Sum) (foldMapOf both) Prelude.length ("hello","world") -- 10-auf :: Profunctor p => AnIso s t a b -> (p r a -> e -> b) -> p r s -> e -> t-auf k = withIso k $ \ sa bt f g e -> bt (f (rmap sa g) e)+--+-- Mnemonically, the German /auf/ plays a similar role to /à la/, and the combinator+-- is 'au' with an extra function argument:+--+-- @+-- 'auf' :: 'Iso' s t a b -> ((r -> a) -> e -> b) -> (r -> s) -> e -> t+-- @+--+-- but the signature is general.+auf :: (Functor f, Functor g) => Optic (Costar f) g s t a b -> (f a -> g b) -> f s -> g t+auf = coerce {-# INLINE auf #-} -- | The opposite of working 'Control.Lens.Setter.over' a 'Setter' is working 'under' an isomorphism.@@ -367,6 +413,20 @@ class Strict lazy strict | lazy -> strict, strict -> lazy where strict :: Iso' lazy strict +#if __GLASGOW_HASKELL__ >= 710+pattern Strict a <- (view strict -> a) where+ Strict a = review strict a++pattern Lazy a <- (view lazy -> a) where+ Lazy a = review lazy a++pattern Swapped a <- (view swapped -> a) where+ Swapped a = review swapped a++pattern Reversed a <- (view reversed -> a) where+ Reversed a = review reversed a+#endif+ instance Strict LazyB.ByteString StrictB.ByteString where #if MIN_VERSION_bytestring(0,10,0) strict = iso LazyB.toStrict LazyB.fromStrict@@ -428,6 +488,11 @@ involuted a = iso a a {-# INLINE involuted #-} +#if __GLASGOW_HASKELL__ >= 710+pattern List a <- (Exts.toList -> a) where+ List a = Exts.fromList a+#endif+ ------------------------------------------------------------------------------ -- Magma ------------------------------------------------------------------------------@@ -509,3 +574,13 @@ bimapping f g = withIso f $ \ sa bt -> withIso g $ \s'a' b't' -> iso (bimap sa s'a') (bimap bt b't') {-# INLINE bimapping #-}++#if __GLASGOW_HASKELL__ >= 710+-- | Data types that are representationally equal are isomorphic.+--+-- This is only available on GHC 7.10++--+-- @since 4.13+coerced :: forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b+coerced l = rmap (fmap coerce') l .# coerce+#endif
src/Control/Lens/Lens.hs view
@@ -290,7 +290,7 @@ -- ('%%~') :: 'Lens' s t a b -> (a -> (r, b)) -> s -> (r, t) -- ('%%~') :: 'Monoid' m => 'Control.Lens.Traversal.Traversal' s t a b -> (a -> (m, b)) -> s -> (m, t) -- @-(%%~) :: Optical p q f s t a b -> p a (f b) -> q s (f t)+(%%~) :: LensLike f s t a b -> (a -> f b) -> s -> f t (%%~) = id {-# INLINE (%%~) #-} @@ -552,8 +552,8 @@ -- ('<%~') :: 'Control.Lens.Iso.Iso' s t a b -> (a -> b) -> s -> (b, t) -- ('<%~') :: 'Monoid' b => 'Control.Lens.Traversal.Traversal' s t a b -> (a -> b) -> s -> (b, t) -- @-(<%~) :: Profunctor p => Optical p q ((,) b) s t a b -> p a b -> q s (b, t)-l <%~ f = l $ rmap (\t -> (t, t)) f+(<%~) :: LensLike ((,) b) s t a b -> (a -> b) -> s -> (b, t)+l <%~ f = l $ (\t -> (t, t)) . f {-# INLINE (<%~) #-} -- | Increment the target of a numerically valued 'Lens' and return the result.@@ -564,7 +564,7 @@ -- ('<+~') :: 'Num' a => 'Lens'' s a -> a -> s -> (a, s) -- ('<+~') :: 'Num' a => 'Control.Lens.Iso.Iso'' s a -> a -> s -> (a, s) -- @-(<+~) :: Num a => Optical (->) q ((,)a) s t a a -> a -> q s (a, t)+(<+~) :: Num a => LensLike ((,)a) s t a a -> a -> s -> (a, t) l <+~ a = l <%~ (+ a) {-# INLINE (<+~) #-} @@ -576,7 +576,7 @@ -- ('<-~') :: 'Num' a => 'Lens'' s a -> a -> s -> (a, s) -- ('<-~') :: 'Num' a => 'Control.Lens.Iso.Iso'' s a -> a -> s -> (a, s) -- @-(<-~) :: Num a => Optical (->) q ((,)a) s t a a -> a -> q s (a, t)+(<-~) :: Num a => LensLike ((,)a) s t a a -> a -> s -> (a, t) l <-~ a = l <%~ subtract a {-# INLINE (<-~) #-} @@ -589,7 +589,7 @@ -- ('<*~') :: 'Num' a => 'Lens'' s a -> a -> s -> (a, s) -- ('<*~') :: 'Num' a => 'Control.Lens.Iso.Iso'' s a -> a -> s -> (a, s) -- @-(<*~) :: Num a => Optical (->) q ((,)a) s t a a -> a -> q s (a, t)+(<*~) :: Num a => LensLike ((,)a) s t a a -> a -> s -> (a, t) l <*~ a = l <%~ (* a) {-# INLINE (<*~) #-} @@ -601,7 +601,7 @@ -- ('<//~') :: 'Fractional' a => 'Lens'' s a -> a -> s -> (a, s) -- ('<//~') :: 'Fractional' a => 'Control.Lens.Iso.Iso'' s a -> a -> s -> (a, s) -- @-(<//~) :: Fractional a => Optical (->) q ((,)a) s t a a -> a -> q s (a, t)+(<//~) :: Fractional a => LensLike ((,)a) s t a a -> a -> s -> (a, t) l <//~ a = l <%~ (/ a) {-# INLINE (<//~) #-} @@ -614,7 +614,7 @@ -- ('<^~') :: ('Num' a, 'Integral' e) => 'Lens'' s a -> e -> s -> (a, s) -- ('<^~') :: ('Num' a, 'Integral' e) => 'Control.Lens.Iso.Iso'' s a -> e -> s -> (a, s) -- @-(<^~) :: (Num a, Integral e) => Optical (->) q ((,)a) s t a a -> e -> q s (a, t)+(<^~) :: (Num a, Integral e) => LensLike ((,)a) s t a a -> e -> s -> (a, t) l <^~ e = l <%~ (^ e) {-# INLINE (<^~) #-} @@ -627,7 +627,7 @@ -- ('<^^~') :: ('Fractional' a, 'Integral' e) => 'Lens'' s a -> e -> s -> (a, s) -- ('<^^~') :: ('Fractional' a, 'Integral' e) => 'Control.Lens.Iso.Iso'' s a -> e -> s -> (a, s) -- @-(<^^~) :: (Fractional a, Integral e) => Optical (->) q ((,)a) s t a a -> e -> q s (a, t)+(<^^~) :: (Fractional a, Integral e) => LensLike ((,)a) s t a a -> e -> s -> (a, t) l <^^~ e = l <%~ (^^ e) {-# INLINE (<^^~) #-} @@ -640,7 +640,7 @@ -- ('<**~') :: 'Floating' a => 'Lens'' s a -> a -> s -> (a, s) -- ('<**~') :: 'Floating' a => 'Control.Lens.Iso.Iso'' s a -> a -> s -> (a, s) -- @-(<**~) :: Floating a => Optical (->) q ((,)a) s t a a -> a -> q s (a, t)+(<**~) :: Floating a => LensLike ((,)a) s t a a -> a -> s -> (a, t) l <**~ a = l <%~ (** a) {-# INLINE (<**~) #-} @@ -652,7 +652,7 @@ -- ('<||~') :: 'Lens'' s 'Bool' -> 'Bool' -> s -> ('Bool', s) -- ('<||~') :: 'Control.Lens.Iso.Iso'' s 'Bool' -> 'Bool' -> s -> ('Bool', s) -- @-(<||~) :: Optical (->) q ((,)Bool) s t Bool Bool -> Bool -> q s (Bool, t)+(<||~) :: LensLike ((,)Bool) s t Bool Bool -> Bool -> s -> (Bool, t) l <||~ b = l <%~ (|| b) {-# INLINE (<||~) #-} @@ -664,7 +664,7 @@ -- ('<&&~') :: 'Lens'' s 'Bool' -> 'Bool' -> s -> ('Bool', s) -- ('<&&~') :: 'Control.Lens.Iso.Iso'' s 'Bool' -> 'Bool' -> s -> ('Bool', s) -- @-(<&&~) :: Optical (->) q ((,)Bool) s t Bool Bool -> Bool -> q s (Bool, t)+(<&&~) :: LensLike ((,)Bool) s t Bool Bool -> Bool -> s -> (Bool, t) l <&&~ b = l <%~ (&& b) {-# INLINE (<&&~) #-} @@ -677,7 +677,7 @@ -- ('<<%~') :: 'Control.Lens.Iso.Iso' s t a b -> (a -> b) -> s -> (a, t) -- ('<<%~') :: 'Monoid' a => 'Control.Lens.Traversal.Traversal' s t a b -> (a -> b) -> s -> (a, t) -- @-(<<%~) :: Strong p => Optical p q ((,)a) s t a b -> p a b -> q s (a, t)+(<<%~) :: LensLike ((,)a) s t a b -> (a -> b) -> s -> (a, t) (<<%~) l = l . lmap (\a -> (a, a)) . second' {-# INLINE (<<%~) #-} @@ -690,7 +690,7 @@ -- ('<<.~') :: 'Control.Lens.Iso.Iso' s t a b -> b -> s -> (a, t) -- ('<<.~') :: 'Monoid' a => 'Control.Lens.Traversal.Traversal' s t a b -> b -> s -> (a, t) -- @-(<<.~) :: Optical (->) q ((,)a) s t a b -> b -> q s (a, t)+(<<.~) :: LensLike ((,)a) s t a b -> b -> s -> (a, t) l <<.~ b = l $ \a -> (a, b) {-# INLINE (<<.~) #-} @@ -708,7 +708,7 @@ -- ('<<+~') :: 'Num' a => 'Lens'' s a -> a -> s -> (a, s) -- ('<<+~') :: 'Num' a => 'Iso'' s a -> a -> s -> (a, s) -- @-(<<+~) :: Num a => Optical' (->) q ((,) a) s a -> a -> q s (a, s)+(<<+~) :: Num a => LensLike' ((,) a) s a -> a -> s -> (a, s) l <<+~ b = l $ \a -> (a, a + b) {-# INLINE (<<+~) #-} @@ -726,7 +726,7 @@ -- ('<<-~') :: 'Num' a => 'Lens'' s a -> a -> s -> (a, s) -- ('<<-~') :: 'Num' a => 'Iso'' s a -> a -> s -> (a, s) -- @-(<<-~) :: Num a => Optical' (->) q ((,) a) s a -> a -> q s (a, s)+(<<-~) :: Num a => LensLike' ((,) a) s a -> a -> s -> (a, s) l <<-~ b = l $ \a -> (a, a - b) {-# INLINE (<<-~) #-} @@ -744,7 +744,7 @@ -- ('<<*~') :: 'Num' a => 'Lens'' s a -> a -> s -> (a, s) -- ('<<*~') :: 'Num' a => 'Iso'' s a -> a -> s -> (a, s) -- @-(<<*~) :: Num a => Optical' (->) q ((,) a) s a -> a -> q s (a, s)+(<<*~) :: Num a => LensLike' ((,) a) s a -> a -> s -> (a, s) l <<*~ b = l $ \a -> (a, a * b) {-# INLINE (<<*~) #-} @@ -762,7 +762,7 @@ -- ('<<//~') :: Fractional a => 'Lens'' s a -> a -> s -> (a, s) -- ('<<//~') :: Fractional a => 'Iso'' s a -> a -> s -> (a, s) -- @-(<<//~) :: Fractional a => Optical' (->) q ((,) a) s a -> a -> q s (a, s)+(<<//~) :: Fractional a => LensLike' ((,) a) s a -> a -> s -> (a, s) l <<//~ b = l $ \a -> (a, a / b) {-# INLINE (<<//~) #-} @@ -774,7 +774,7 @@ -- ('<<^~') :: ('Num' a, 'Integral' e) => 'Lens'' s a -> e -> s -> (a, s) -- ('<<^~') :: ('Num' a, 'Integral' e) => 'Iso'' s a -> e -> s -> (a, s) -- @-(<<^~) :: (Num a, Integral e) => Optical' (->) q ((,) a) s a -> e -> q s (a, s)+(<<^~) :: (Num a, Integral e) => LensLike' ((,) a) s a -> e -> s -> (a, s) l <<^~ e = l $ \a -> (a, a ^ e) {-# INLINE (<<^~) #-} @@ -786,7 +786,7 @@ -- ('<<^^~') :: ('Fractional' a, 'Integral' e) => 'Lens'' s a -> e -> s -> (a, s) -- ('<<^^~') :: ('Fractional' a, 'Integral' e) => 'Iso'' s a -> e -> S -> (a, s) -- @-(<<^^~) :: (Fractional a, Integral e) => Optical' (->) q ((,) a) s a -> e -> q s (a, s)+(<<^^~) :: (Fractional a, Integral e) => LensLike' ((,) a) s a -> e -> s -> (a, s) l <<^^~ e = l $ \a -> (a, a ^^ e) {-# INLINE (<<^^~) #-} @@ -804,7 +804,7 @@ -- ('<<**~') :: 'Floating' a => 'Lens'' s a -> a -> s -> (a, s) -- ('<<**~') :: 'Floating' a => 'Iso'' s a -> a -> s -> (a, s) -- @-(<<**~) :: Floating a => Optical' (->) q ((,) a) s a -> a -> q s (a, s)+(<<**~) :: Floating a => LensLike' ((,) a) s a -> a -> s -> (a, s) l <<**~ e = l $ \a -> (a, a ** e) {-# INLINE (<<**~) #-} @@ -822,7 +822,7 @@ -- ('<<||~') :: 'Lens'' s 'Bool' -> 'Bool' -> s -> ('Bool', s) -- ('<<||~') :: 'Iso'' s 'Bool' -> 'Bool' -> s -> ('Bool', s) -- @-(<<||~) :: Optical' (->) q ((,) Bool) s Bool -> Bool -> q s (Bool, s)+(<<||~) :: LensLike' ((,) Bool) s Bool -> Bool -> s -> (Bool, s) l <<||~ b = l $ \a -> (a, b || a) {-# INLINE (<<||~) #-} @@ -840,7 +840,7 @@ -- ('<<&&~') :: 'Lens'' s Bool -> Bool -> s -> (Bool, s) -- ('<<&&~') :: 'Iso'' s Bool -> Bool -> s -> (Bool, s) -- @-(<<&&~) :: Optical' (->) q ((,) Bool) s Bool -> Bool -> q s (Bool, s)+(<<&&~) :: LensLike' ((,) Bool) s Bool -> Bool -> s -> (Bool, s) l <<&&~ b = l $ \a -> (a, b && a) {-# INLINE (<<&&~) #-} @@ -858,7 +858,7 @@ -- ('<<<>~') :: 'Monoid' r => 'Lens'' s r -> r -> s -> (r, s) -- ('<<<>~') :: 'Monoid' r => 'Iso'' s r -> r -> s -> (r, s) -- @-(<<<>~) :: Monoid r => Optical' (->) q ((,) r) s r -> r -> q s (r, s)+(<<<>~) :: Monoid r => LensLike' ((,) r) s r -> r -> s -> (r, s) l <<<>~ b = l $ \a -> (a, a `mappend` b) {-# INLINE (<<<>~) #-} @@ -879,8 +879,8 @@ -- ('<%=') :: 'MonadState' s m => 'Control.Lens.Iso.Iso'' s a -> (a -> a) -> m a -- ('<%=') :: ('MonadState' s m, 'Monoid' a) => 'Control.Lens.Traversal.Traversal'' s a -> (a -> a) -> m a -- @-(<%=) :: (Profunctor p, MonadState s m) => Over p ((,)b) s s a b -> p a b -> m b-l <%= f = l %%= rmap (\b -> (b, b)) f+(<%=) :: MonadState s m => LensLike ((,)b) s s a b -> (a -> b) -> m b+l <%= f = l %%= (\b -> (b, b)) . f {-# INLINE (<%=) #-} @@ -1015,7 +1015,7 @@ -- @ -- ('<<%=') :: 'MonadState' s m => 'Lens'' s a -> (a -> a) -> m a -- ('<<%=') :: 'MonadState' s m => 'Control.Lens.Iso.Iso'' s a -> (a -> a) -> m a--- ('<<%=') :: ('MonadState' s m, 'Monoid' b) => 'Control.Lens.Traversal.Traversal'' s a -> (a -> a) -> m a+-- ('<<%=') :: ('MonadState' s m, 'Monoid' a) => 'Control.Lens.Traversal.Traversal'' s a -> (a -> a) -> m a -- @ -- -- @('<<%=') :: 'MonadState' s m => 'LensLike' ((,)a) s s a b -> (a -> b) -> m a@@@ -1190,7 +1190,7 @@ -- return the result. -- -- When you do not need the result of the operation, ('Control.Lens.Setter.<>~') is more flexible.-(<<>~) :: Monoid m => Optical (->) q ((,)m) s t m m -> m -> q s (m, t)+(<<>~) :: Monoid m => LensLike ((,)m) s t m m -> m -> s -> (m, t) l <<>~ m = l <%~ (`mappend` m) {-# INLINE (<<>~) #-} @@ -1240,7 +1240,7 @@ -- ('<%@~') :: 'IndexedLens' i s t a b -> (i -> a -> b) -> s -> (b, t) -- ('<%@~') :: 'Monoid' b => 'Control.Lens.Traversal.IndexedTraversal' i s t a b -> (i -> a -> b) -> s -> (b, t) -- @-(<%@~) :: Optical (Indexed i) q ((,) b) s t a b -> (i -> a -> b) -> q s (b, t)+(<%@~) :: Over (Indexed i) ((,) b) s t a b -> (i -> a -> b) -> s -> (b, t) l <%@~ f = l (Indexed $ \i a -> let b = f i a in (b, b)) {-# INLINE (<%@~) #-} @@ -1252,7 +1252,7 @@ -- ('<<%@~') :: 'IndexedLens' i s t a b -> (i -> a -> b) -> s -> (a, t) -- ('<<%@~') :: 'Monoid' a => 'Control.Lens.Traversal.IndexedTraversal' i s t a b -> (i -> a -> b) -> s -> (a, t) -- @-(<<%@~) :: Optical (Indexed i) q ((,) a) s t a b -> (i -> a -> b) -> q s (a, t)+(<<%@~) :: Over (Indexed i) ((,) a) s t a b -> (i -> a -> b) -> s -> (a, t) l <<%@~ f = l $ Indexed $ \i a -> second' (f i) (a,a) {-# INLINE (<<%@~) #-}
src/Control/Lens/Plated.hs view
@@ -357,10 +357,10 @@ -- | Rewrite recursively over part of a larger structure using a specified 'Setter'. -- -- @--- 'rewriteOnOf' :: 'Plated' a => 'Control.Lens.Iso.Iso'' s a -> 'Control.Lens.Iso.Iso'' a a -> (a -> 'Maybe' a) -> s -> s--- 'rewriteOnOf' :: 'Plated' a => 'Lens'' s a -> 'Lens'' a a -> (a -> 'Maybe' a) -> s -> s--- 'rewriteOnOf' :: 'Plated' a => 'Traversal'' s a -> 'Traversal'' a a -> (a -> 'Maybe' a) -> s -> s--- 'rewriteOnOf' :: 'Plated' a => 'Setter'' s a -> 'Setter'' a a -> (a -> 'Maybe' a) -> s -> s+-- 'rewriteOnOf' :: 'Control.Lens.Iso.Iso'' s a -> 'Control.Lens.Iso.Iso'' a a -> (a -> 'Maybe' a) -> s -> s+-- 'rewriteOnOf' :: 'Lens'' s a -> 'Lens'' a a -> (a -> 'Maybe' a) -> s -> s+-- 'rewriteOnOf' :: 'Traversal'' s a -> 'Traversal'' a a -> (a -> 'Maybe' a) -> s -> s+-- 'rewriteOnOf' :: 'Setter'' s a -> 'Setter'' a a -> (a -> 'Maybe' a) -> s -> s -- @ rewriteOnOf :: ASetter s t a a -> ASetter' a a -> (a -> Maybe a) -> s -> t rewriteOnOf b l = over b . rewriteOf l
src/Control/Lens/Reified.hs view
@@ -28,6 +28,7 @@ import Data.Distributive import Data.Foldable import Data.Functor.Compose+import Data.Functor.Contravariant import Data.Functor.Bind import Data.Functor.Extend import Data.Functor.Identity@@ -189,10 +190,10 @@ instance Strong ReifiedGetter where first' l = Getter $ \f (s,c) ->- coerce $ runGetter l (dimap (flip (,) c) coerce f) s+ phantom $ runGetter l (dimap (flip (,) c) phantom f) s {-# INLINE first' #-} second' l = Getter $ \f (c,s) ->- coerce $ runGetter l (dimap ((,) c) coerce f) s+ phantom $ runGetter l (dimap ((,) c) phantom f) s {-# INLINE second' #-} instance Choice ReifiedGetter where@@ -258,10 +259,10 @@ instance Strong (ReifiedIndexedGetter i) where first' l = IndexedGetter $ \f (s,c) ->- coerce $ runIndexedGetter l (dimap (flip (,) c) coerce f) s+ phantom $ runIndexedGetter l (dimap (flip (,) c) phantom f) s {-# INLINE first' #-} second' l = IndexedGetter $ \f (c,s) ->- coerce $ runIndexedGetter l (dimap ((,) c) coerce f) s+ phantom $ runIndexedGetter l (dimap ((,) c) phantom f) s {-# INLINE second' #-} instance Functor (ReifiedIndexedGetter i s) where@@ -272,7 +273,7 @@ IndexedGetter mf <.> IndexedGetter ma = IndexedGetter $ \k s -> case iview mf s of (i, f) -> case iview ma s of- (j, a) -> coerce $ indexed k (i <> j) (f a)+ (j, a) -> phantom $ indexed k (i <> j) (f a) {-# INLINE (<.>) #-} ------------------------------------------------------------------------------@@ -306,10 +307,10 @@ instance Strong ReifiedFold where first' l = Fold $ \f (s,c) ->- coerce $ runFold l (dimap (flip (,) c) coerce f) s+ phantom $ runFold l (dimap (flip (,) c) phantom f) s {-# INLINE first' #-} second' l = Fold $ \f (c,s) ->- coerce $ runFold l (dimap ((,) c) coerce f) s+ phantom $ runFold l (dimap ((,) c) phantom f) s {-# INLINE second' #-} instance Choice ReifiedFold where@@ -460,15 +461,15 @@ instance Representable (ReifiedIndexedFold i) where type Rep (ReifiedIndexedFold i) = Compose [] ((,) i)- tabulate k = IndexedFold $ \f -> coerce . traverse_ (coerce . uncurry (indexed f)) . getCompose . k+ tabulate k = IndexedFold $ \f -> phantom . traverse_ (phantom . uncurry (indexed f)) . getCompose . k {-# INLINE tabulate #-} instance Strong (ReifiedIndexedFold i) where first' l = IndexedFold $ \f (s,c) ->- coerce $ runIndexedFold l (dimap (flip (,) c) coerce f) s+ phantom $ runIndexedFold l (dimap (flip (,) c) phantom f) s {-# INLINE first' #-} second' l = IndexedFold $ \f (c,s) ->- coerce $ runIndexedFold l (dimap ((,) c) coerce f) s+ phantom $ runIndexedFold l (dimap ((,) c) phantom f) s {-# INLINE second' #-} ------------------------------------------------------------------------------
src/Control/Lens/Setter.hs view
@@ -57,7 +57,7 @@ , (.~), (%~) , (+~), (-~), (*~), (//~), (^~), (^^~), (**~), (||~), (<>~), (&&~), (<.~), (?~), (<?~) -- * State Combinators- , assign+ , assign, modifying , (.=), (%=) , (+=), (-=), (*=), (//=), (^=), (^^=), (**=), (||=), (<>=), (&&=), (<.=), (?=), (<?=) , (<~)@@ -68,7 +68,7 @@ -- * Simplified State Setting , set' -- * Indexed Setters- , imapOf, iover, iset+ , imapOf, iover, iset, imodifying , isets , (%@~), (.@~), (%@=), (.@=) -- * Arrow operators@@ -356,7 +356,7 @@ -- 'over' :: 'Setter' s t a b -> (a -> b) -> s -> t -- 'over' :: 'ASetter' s t a b -> (a -> b) -> s -> t -- @-over :: Profunctor p => Setting p s t a b -> p a b -> s -> t+over :: ASetter s t a b -> (a -> b) -> s -> t over l f = runIdentity #. l (Identity #. f) {-# INLINE over #-} @@ -447,7 +447,7 @@ -- ('%~') :: 'Lens' s t a b -> (a -> b) -> s -> t -- ('%~') :: 'Traversal' s t a b -> (a -> b) -> s -> t -- @-(%~) :: Profunctor p => Setting p s t a b -> p a b -> s -> t+(%~) :: ASetter s t a b -> (a -> b) -> s -> t (%~) = over {-# INLINE (%~) #-} @@ -794,10 +794,15 @@ -- @ -- ('%=') :: 'MonadState' s m => 'ASetter' s s a b -> (a -> b) -> m () -- @-(%=) :: (Profunctor p, MonadState s m) => Setting p s s a b -> p a b -> m ()+(%=) :: MonadState s m => ASetter s s a b -> (a -> b) -> m () l %= f = State.modify (l %~ f) {-# INLINE (%=) #-} +-- | This is an alias for ('%=').+modifying :: MonadState s m => ASetter s s a b -> (a -> b) -> m ()+modifying l f = State.modify (over l f)+{-# INLINE modifying #-}+ -- | Replace the target of a 'Lens' or all of the targets of a 'Setter' or 'Traversal' in our monadic -- state with 'Just' a new value, irrespective of the old. --@@ -1129,7 +1134,7 @@ -- 'iover' :: 'IndexedTraversal' i s t a b -> (i -> a -> b) -> s -> t -- @ iover :: AnIndexedSetter i s t a b -> (i -> a -> b) -> s -> t-iover l = over l .# Indexed+iover l f = runIdentity #. l (Identity #. Indexed f) {-# INLINE iover #-} -- | Set with index. Equivalent to 'iover' with the current value ignored.@@ -1165,8 +1170,8 @@ -- 'iover' '.' 'isets' ≡ 'id' -- @ ----- Another way to view 'sets' is that it takes a \"semantic editor combinator\"--- and transforms it into a 'Setter'.+-- Another way to view 'isets' is that it takes a \"semantic editor combinator\"+-- which has been modified to carry an index and transforms it into a 'IndexedSetter'. isets :: ((i -> a -> b) -> s -> t) -> IndexedSetter i s t a b isets f = sets (f . indexed) {-# INLINE isets #-}@@ -1190,7 +1195,7 @@ -- ('%@~') :: 'IndexedTraversal' i s t a b -> (i -> a -> b) -> s -> t -- @ (%@~) :: AnIndexedSetter i s t a b -> (i -> a -> b) -> s -> t-l %@~ f = l %~ Indexed f+(%@~) = iover {-# INLINE (%@~) #-} -- | Replace every target of an 'IndexedSetter', 'IndexedLens' or 'IndexedTraversal'@@ -1212,7 +1217,7 @@ -- ('.@~') :: 'IndexedTraversal' i s t a b -> (i -> b) -> s -> t -- @ (.@~) :: AnIndexedSetter i s t a b -> (i -> b) -> s -> t-l .@~ f = l %~ Indexed (const . f)+l .@~ f = runIdentity #. l (Identity #. Indexed (const . f)) {-# INLINE (.@~) #-} -- | Adjust every target in the current state of an 'IndexedSetter', 'IndexedLens' or 'IndexedTraversal'@@ -1233,6 +1238,11 @@ l %@= f = State.modify (l %@~ f) {-# INLINE (%@=) #-} +-- | This is an alias for ('%@=').+imodifying :: MonadState s m => AnIndexedSetter i s s a b -> (i -> a -> b) -> m ()+imodifying l f = State.modify (iover l f)+{-# INLINE imodifying #-}+ -- | Replace every target in the current state of an 'IndexedSetter', 'IndexedLens' or 'IndexedTraversal' -- with access to the index. --@@ -1291,7 +1301,7 @@ ------------------------------------------------------------------------------ -- | 'mapOf' is a deprecated alias for 'over'.-mapOf :: Profunctor p => Setting p s t a b -> p a b -> s -> t+mapOf :: ASetter s t a b -> (a -> b) -> s -> t mapOf = over {-# INLINE mapOf #-} {-# DEPRECATED mapOf "Use `over`" #-}
src/Control/Lens/Traversal.hs view
@@ -113,6 +113,12 @@ , imapAccumROf , imapAccumLOf + -- * Reflection+ , traverseBy+ , traverseByOf+ , sequenceBy+ , sequenceByOf+ -- * Implementation Details , Bazaar(..), Bazaar' , Bazaar1(..), Bazaar1'@@ -128,7 +134,7 @@ import Control.Category import Control.Comonad import Control.Lens.Fold-import Control.Lens.Getter (Getting, IndexedGetting, coerced)+import Control.Lens.Getter (Getting, IndexedGetting, getting) import Control.Lens.Internal.Bazaar import Control.Lens.Internal.Context import Control.Lens.Internal.Indexed@@ -154,6 +160,7 @@ import Data.Profunctor.Rep import Data.Profunctor.Sieve import Data.Profunctor.Unsafe+import Data.Reflection import Data.Semigroup.Traversable import Data.Tagged import Data.Traversable@@ -267,7 +274,7 @@ -- 'traverseOf' :: 'Functor' f => 'Lens' s t a b -> (a -> f b) -> s -> f t -- 'traverseOf' :: 'Applicative' f => 'Traversal' s t a b -> (a -> f b) -> s -> f t -- @-traverseOf :: Over p f s t a b -> p a (f b) -> s -> f t+traverseOf :: LensLike f s t a b -> (a -> f b) -> s -> f t traverseOf = id {-# INLINE traverseOf #-} @@ -296,7 +303,7 @@ -- 'forOf' :: 'Functor' f => 'Lens' s t a b -> s -> (a -> f b) -> f t -- 'forOf' :: 'Applicative' f => 'Traversal' s t a b -> s -> (a -> f b) -> f t -- @-forOf :: Over p f s t a b -> s -> p a (f b) -> f t+forOf :: LensLike f s t a b -> s -> (a -> f b) -> f t forOf = flip {-# INLINE forOf #-} @@ -336,7 +343,7 @@ -- 'mapMOf' :: 'Monad' m => 'Lens' s t a b -> (a -> m b) -> s -> m t -- 'mapMOf' :: 'Monad' m => 'Traversal' s t a b -> (a -> m b) -> s -> m t -- @-mapMOf :: Profunctor p => Over p (WrappedMonad m) s t a b -> p a (m b) -> s -> m t+mapMOf :: LensLike (WrappedMonad m) s t a b -> (a -> m b) -> s -> m t mapMOf l cmd = unwrapMonad #. l (WrapMonad #. cmd) {-# INLINE mapMOf #-} @@ -356,7 +363,7 @@ -- 'forMOf' :: 'Monad' m => 'Lens' s t a b -> s -> (a -> m b) -> m t -- 'forMOf' :: 'Monad' m => 'Traversal' s t a b -> s -> (a -> m b) -> m t -- @-forMOf :: Profunctor p => Over p (WrappedMonad m) s t a b -> s -> p a (m b) -> m t+forMOf :: LensLike (WrappedMonad m) s t a b -> s -> (a -> m b) -> m t forMOf l a cmd = unwrapMonad (l (WrapMonad #. cmd) a) {-# INLINE forMOf #-} @@ -418,7 +425,7 @@ -- @ -- 'mapAccumROf' :: 'LensLike' ('Backwards' ('State' acc)) s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t) -- @-mapAccumROf :: Conjoined p => Over p (Backwards (State acc)) s t a b -> p acc (a -> (acc, b)) -> acc -> s -> (acc, t)+mapAccumROf :: LensLike (Backwards (State acc)) s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t) mapAccumROf = mapAccumLOf . backwards {-# INLINE mapAccumROf #-} @@ -441,9 +448,9 @@ -- 'mapAccumLOf' l f acc0 s = 'swap' ('runState' (l (\a -> 'state' (\acc -> 'swap' (f acc a))) s) acc0) -- @ ---mapAccumLOf :: Conjoined p => Over p (State acc) s t a b -> p acc (a -> (acc, b)) -> acc -> s -> (acc, t)+mapAccumLOf :: LensLike (State acc) s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t) mapAccumLOf l f acc0 s = swap (runState (l g s) acc0) where- g = cotabulate $ \wa -> state $ \acc -> swap (cosieve f (acc <$ wa) (extract wa))+ g a = state $ \acc -> swap (f acc a) -- This would be much cleaner if the argument order for the function was swapped. {-# INLINE mapAccumLOf #-} @@ -693,7 +700,7 @@ ------------------------------------------------------------------------------ ins :: Bizarre (->) w => w a b t -> [a]-ins = toListOf (coerced bazaar)+ins = toListOf (getting bazaar) {-# INLINE ins #-} wins :: (Bizarre p w, Corepresentable p, Comonad (Corep p)) => w a b t -> [a]@@ -862,7 +869,7 @@ -- former can execute at full speed, while the latter needs to round trip through -- the 'Bazaar'. ----- >>> let foo l a = (view (coerced (cloneTraversal l)) a, set (cloneTraversal l) 10 a)+-- >>> let foo l a = (view (getting (cloneTraversal l)) a, set (cloneTraversal l) 10 a) -- >>> foo both ("hello","world") -- ("helloworld",(10,10)) --@@ -954,8 +961,8 @@ -- 'imapMOf' :: 'Monad' m => 'IndexedTraversal' i s t a b -> (i -> a -> m b) -> s -> m t -- 'imapMOf' :: 'Bind' m => 'IndexedTraversal1' i s t a b -> (i -> a -> m b) -> s -> m t -- @-imapMOf :: (Indexed i a (WrappedMonad m b) -> s -> WrappedMonad m t) -> (i -> a -> m b) -> s -> m t-imapMOf l = mapMOf l .# Indexed+imapMOf :: Over (Indexed i) (WrappedMonad m) s t a b -> (i -> a -> m b) -> s -> m t+imapMOf l cmd = unwrapMonad #. l (WrapMonad #. Indexed cmd) {-# INLINE imapMOf #-} -- | Map each element of a structure targeted by a 'Lens' to a monadic action,@@ -988,7 +995,7 @@ -- 'imapAccumROf' :: 'IndexedTraversal' i s t a b -> (i -> acc -> a -> (acc, b)) -> acc -> s -> (acc, t) -- @ imapAccumROf :: Over (Indexed i) (Backwards (State acc)) s t a b -> (i -> acc -> a -> (acc, b)) -> acc -> s -> (acc, t)-imapAccumROf l = mapAccumROf l .# Indexed+imapAccumROf = imapAccumLOf . backwards {-# INLINE imapAccumROf #-} -- | Generalizes 'Data.Traversable.mapAccumL' to an arbitrary 'IndexedTraversal' with access to the index.@@ -1004,7 +1011,8 @@ -- 'imapAccumLOf' :: 'IndexedTraversal' i s t a b -> (i -> acc -> a -> (acc, b)) -> acc -> s -> (acc, t) -- @ imapAccumLOf :: Over (Indexed i) (State acc) s t a b -> (i -> acc -> a -> (acc, b)) -> acc -> s -> (acc, t)-imapAccumLOf l = mapAccumLOf l .# Indexed+imapAccumLOf l f acc0 s = swap (runState (l (Indexed g) s) acc0) where+ g i a = state $ \acc -> swap (f i acc a) {-# INLINE imapAccumLOf #-} ------------------------------------------------------------------------------@@ -1171,8 +1179,8 @@ -- @ -- 'failover' :: Alternative m => Traversal s t a b -> (a -> b) -> s -> m t -- @-failover :: (Profunctor p, Alternative m) => Over p ((,) Any) s t a b -> p a b -> s -> m t-failover l pafb s = case l ((,) (Any True) `rmap` pafb) s of+failover :: Alternative m => LensLike ((,) Any) s t a b -> (a -> b) -> s -> m t+failover l afb s = case l ((,) (Any True) . afb) s of (Any True, t) -> pure t (Any False, _) -> Applicative.empty {-# INLINE failover #-}@@ -1183,7 +1191,9 @@ -- 'ifailover' :: Alternative m => IndexedTraversal i s t a b -> (i -> a -> b) -> s -> m t -- @ ifailover :: Alternative m => Over (Indexed i) ((,) Any) s t a b -> (i -> a -> b) -> s -> m t-ifailover l f = failover l (Indexed f)+ifailover l iafb s = case l ((,) (Any True) `rmap` Indexed iafb) s of+ (Any True, t) -> pure t+ (Any False, _) -> Applicative.empty {-# INLINE ifailover #-} -- | Try the first 'Traversal' (or 'Fold'), falling back on the second 'Traversal' (or 'Fold') if it returns no entries.@@ -1290,3 +1300,23 @@ {-# INLINE yap #-} {-# INLINE confusing #-}++-- | Traverse a container using a specified 'Applicative'.+--+-- This is like 'traverseBy' where the 'Traversable' instance can be specified by any 'Traversal'+--+-- @+-- 'traverseByOf' 'traverse' ≡ 'traverseBy'+-- @+traverseByOf :: Traversal s t a b -> (forall x. x -> f x) -> (forall x y. f (x -> y) -> f x -> f y) -> (a -> f b) -> s -> f t+traverseByOf l pur app f = reifyApplicative pur app (l (ReflectedApplicative #. f))++-- | Sequence a container using a specified 'Applicative'.+--+-- This is like 'traverseBy' where the 'Traversable' instance can be specified by any 'Traversal'+--+-- @+-- 'sequenceByOf' 'traverse' ≡ 'sequenceBy'+-- @+sequenceByOf :: Traversal s t (f b) b -> (forall x. x -> f x) -> (forall x y. f (x -> y) -> f x -> f y) -> s -> f t+sequenceByOf l pur app = reifyApplicative pur app (l ReflectedApplicative)
src/Control/Lens/Type.hs view
@@ -545,7 +545,7 @@ type Optic p f s t a b = p a (f b) -> p s (f t) -- | @--- type 'Optic'' p q f s a = 'Simple' ('Optic' p q f) s a+-- type 'Optic'' p f s a = 'Simple' ('Optic' p f) s a -- @ type Optic' p f s a = Optic p f s s a a
src/Control/Lens/Wrapped.hs view
@@ -6,12 +6,20 @@ {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE UndecidableInstances #-}-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706++#if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-} #endif+ #ifdef TRUSTWORTHY {-# LANGUAGE Trustworthy #-} #endif++#if __GLASGOW_HASKELL__ >= 710+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE ViewPatterns #-}+#endif+ {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} #ifndef MIN_VERSION_base@@ -62,8 +70,14 @@ -- * Operations , op , ala, alaf+#if __GLASGOW_HASKELL__ >= 710+ -- * Pattern Synonyms+ , pattern Wrapped+ , pattern Unwrapped+#endif ) where + import Control.Applicative import Control.Arrow import Control.Applicative.Backwards@@ -71,6 +85,9 @@ import Control.Exception import Control.Lens.Getter import Control.Lens.Iso+#if __GLASGOW_HASKELL__ >= 710+import Control.Lens.Review+#endif import Control.Monad.Trans.Cont import Control.Monad.Trans.Error import Control.Monad.Trans.Identity@@ -108,6 +125,12 @@ import Data.Vector.Unboxed as Unboxed import Data.Vector.Storable as Storable +#if MIN_VERSION_base(4,6,0)+import Data.Ord (Down(Down))+#else+import GHC.Exts (Down(Down))+#endif+ #ifdef HLINT {-# ANN module "HLint: ignore Use uncurry" #-} #endif@@ -123,6 +146,16 @@ -- | An isomorphism between @s@ and @a@. _Wrapped' :: Iso' s (Unwrapped s) +#if __GLASGOW_HASKELL__ >= 710++pattern Wrapped a <- (view _Wrapped -> a) where+ Wrapped a = review _Wrapped a++pattern Unwrapped a <- (view _Unwrapped -> a) where+ Unwrapped a = review _Unwrapped a++#endif+ -- This can be used to help inference between the wrappers class Wrapped s => Rewrapped (s :: *) (t :: *) @@ -131,6 +164,7 @@ _Unwrapped' :: Wrapped s => Iso' (Unwrapped s) s _Unwrapped' = from _Wrapped'+{-# INLINE _Unwrapped' #-} -- | Work under a newtype wrapper. --@@ -249,6 +283,11 @@ _Wrapped' = iso getArrowMonad ArrowMonad {-# INLINE _Wrapped' #-} +instance t ~ Down a => Rewrapped (Down a) t+instance Wrapped (Down a) where+ type Unwrapped (Down a) = a+ _Wrapped' = iso (\(Down a) -> a) Down+ -- * transformers instance (t ~ Backwards g b) => Rewrapped (Backwards f a) t@@ -679,7 +718,15 @@ -- -- >>> ala Product foldMap [1,2,3,4] -- 24-ala :: Rewrapping s t => (Unwrapped s -> s) -> ((Unwrapped t -> t) -> e -> s) -> e -> Unwrapped s+--+--+-- You may want to think of this combinator as having the following, simpler, type.+--+-- @+-- ala :: Rewrapping s t => (Unwrapped s -> s) -> ((Unwrapped t -> t) -> e -> s) -> e -> Unwrapped s+-- @++ala :: (Functor f, Rewrapping s t) => (Unwrapped s -> s) -> ((Unwrapped t -> t) -> f s) -> f (Unwrapped s) ala = au . _Wrapping {-# INLINE ala #-} @@ -687,8 +734,12 @@ -- -- As with '_Wrapping', the user supplied function for the newtype is /ignored/. --+-- @+-- alaf :: Rewrapping s t => (Unwrapped s -> s) -> ((r -> t) -> e -> s) -> (r -> Unwrapped t) -> e -> Unwrapped s+-- @+-- -- >>> alaf Sum foldMap Prelude.length ["hello","world"] -- 10-alaf :: (Profunctor p, Rewrapping s t) => (Unwrapped s -> s) -> (p r t -> e -> s) -> p r (Unwrapped t) -> e -> Unwrapped s+alaf :: (Functor f, Functor g, Rewrapping s t) => (Unwrapped s -> s) -> (f t -> g s) -> f (Unwrapped t) -> g (Unwrapped s) alaf = auf . _Unwrapping {-# INLINE alaf #-}
src/Data/ByteString/Lazy/Lens.hs view
@@ -1,4 +1,11 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-}++#if __GLASGOW_HASKELL__ >= 710+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE PatternSynonyms #-}+#endif+ ----------------------------------------------------------------------------- -- | -- Module : Data.ByteString.Lazy.Lens@@ -13,6 +20,10 @@ module Data.ByteString.Lazy.Lens ( packedBytes, unpackedBytes, bytes , packedChars, unpackedChars, chars+#if __GLASGOW_HASKELL__ >= 710+ , pattern Bytes+ , pattern Chars+#endif ) where import Control.Lens@@ -127,3 +138,11 @@ chars :: IndexedTraversal' Int64 ByteString Char chars = traversedLazy8 {-# INLINE chars #-}++#if __GLASGOW_HASKELL__ >= 710+pattern Bytes b <- (view unpackedBytes -> b) where+ Bytes b = review unpackedBytes b++pattern Chars b <- (view unpackedChars -> b) where+ Chars b = review unpackedChars b+#endif
src/Data/ByteString/Lens.hs view
@@ -1,4 +1,9 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-}+#if __GLASGOW_HASKELL__ >= 710+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE PatternSynonyms #-}+#endif ----------------------------------------------------------------------------- -- | -- Module : Data.ByteString.Lens@@ -13,6 +18,10 @@ ( IsByteString(..) , unpackedBytes , unpackedChars+#if __GLASGOW_HASKELL__ >= 710+ , pattern Bytes+ , pattern Chars+#endif ) where import Control.Lens@@ -100,6 +109,14 @@ unpackedBytes :: IsByteString t => Iso' t [Word8] unpackedBytes = from packedBytes {-# INLINE unpackedBytes #-}++#if __GLASGOW_HASKELL__ >= 710+pattern Bytes b <- (view unpackedBytes -> b) where+ Bytes b = review unpackedBytes b+ +pattern Chars b <- (view unpackedChars -> b) where+ Chars b = review unpackedChars b+#endif -- | 'Data.ByteString.Char8.unpack' (or 'Data.ByteString.Char8.pack') a list of characters into a strict (or lazy) 'ByteString' --
src/Data/ByteString/Strict/Lens.hs view
@@ -1,5 +1,10 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-}+#if __GLASGOW_HASKELL__ >= 710+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE PatternSynonyms #-}+#endif+ ----------------------------------------------------------------------------- -- | -- Module : Data.ByteString.Strict.Lens@@ -13,6 +18,10 @@ module Data.ByteString.Strict.Lens ( packedBytes, unpackedBytes, bytes , packedChars, unpackedChars, chars+#if __GLASGOW_HASKELL__ >= 710+ , pattern Bytes+ , pattern Chars+#endif ) where import Control.Lens@@ -126,3 +135,12 @@ chars :: IndexedTraversal' Int ByteString Char chars = traversedStrictTree8 {-# INLINE chars #-}++#if __GLASGOW_HASKELL__ >= 710+pattern Bytes b <- (view unpackedBytes -> b) where+ Bytes b = review unpackedBytes b++pattern Chars b <- (view unpackedChars -> b) where+ Chars b = review unpackedChars b+#endif+
src/Data/Complex/Lens.hs view
@@ -1,5 +1,9 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-}+#if __GLASGOW_HASKELL__ >= 710+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE PatternSynonyms #-}+#endif #ifndef MIN_VERSION_base #define MIN_VERSION_base(x,y,z) 1@@ -24,6 +28,13 @@ , _magnitude , _phase , _conjugate+#if __GLASGOW_HASKELL__ >= 710+ -- * Pattern Synonyms+ , pattern Polar+ , pattern Real+ , pattern Imaginary+ , pattern Conjugate+#endif ) where import Control.Lens@@ -77,6 +88,14 @@ _polar = iso polar (uncurry mkPolar) {-# INLINE _polar #-} +#if __GLASGOW_HASKELL__ >= 710+pattern Polar m theta <- (view _polar -> (m, theta)) where+ Polar m theta = review _polar (m, theta)++pattern Real r = r :+ 0+pattern Imaginary i = 0 :+ i+#endif+ -- | Access the 'magnitude' of a 'Complex' number. -- -- >>> (10.0 :+ 20.0) & _magnitude *~ 2@@ -128,3 +147,8 @@ _conjugate :: RealFloat a => Iso' (Complex a) (Complex a) _conjugate = involuted conjugate {-# INLINE _conjugate #-}++#if __GLASGOW_HASKELL__ >= 710+pattern Conjugate a <- (conjugate -> a) where+ Conjugate a = conjugate a+#endif
src/Data/Dynamic/Lens.hs view
@@ -1,5 +1,11 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-}++#if __GLASGOW_HASKELL__ >= 710+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE ViewPatterns #-}+#endif ----------------------------------------------------------------------------- -- | -- Module : Data.Dynamic.Lens@@ -12,6 +18,9 @@ ---------------------------------------------------------------------------- module Data.Dynamic.Lens ( AsDynamic(..)+#if __GLASGOW_HASKELL__ >= 710+ , pattern Dynamic+#endif ) where import Control.Exception@@ -40,3 +49,8 @@ instance AsDynamic SomeException where _Dynamic = exception.prism' toDyn fromDynamic {-# INLINE _Dynamic #-}++#if __GLASGOW_HASKELL__ >= 710+pattern Dynamic a <- (preview _Dynamic -> Just a) where+ Dynamic a = review _Dynamic a+#endif
src/Data/Sequence/Lens.hs view
@@ -43,12 +43,12 @@ -- >>> EmptyL ^. from viewL -- fromList [] ----- >>> review viewL $ a :< fromList [b,c]+-- >>> review viewL $ a Seq.:< fromList [b,c] -- fromList [a,b,c] viewL :: Iso (Seq a) (Seq b) (ViewL a) (ViewL b) viewL = iso viewl $ \ xs -> case xs of EmptyL -> mempty- a :< as -> a Seq.<| as+ a Seq.:< as -> a Seq.<| as {-# INLINE viewL #-} -- | A 'Seq' is isomorphic to a 'ViewR'@@ -64,12 +64,12 @@ -- >>> EmptyR ^. from viewR -- fromList [] ----- >>> review viewR $ fromList [a,b] :> c+-- >>> review viewR $ fromList [a,b] Seq.:> c -- fromList [a,b,c] viewR :: Iso (Seq a) (Seq b) (ViewR a) (ViewR b) viewR = iso viewr $ \xs -> case xs of EmptyR -> mempty- as :> a -> as Seq.|> a+ as Seq.:> a -> as Seq.|> a {-# INLINE viewR #-} -- | Traverse the first @n@ elements of a 'Seq'
src/Data/Text/Lazy/Lens.hs view
@@ -1,6 +1,10 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}+#if __GLASGOW_HASKELL__ >= 710+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE ViewPatterns #-}+#endif ----------------------------------------------------------------------------- -- | -- Module : Data.Text.Lazy.Lens@@ -17,6 +21,9 @@ , text , builder , utf8+#if __GLASGOW_HASKELL__ >= 710+ , pattern Text+#endif ) where import Control.Lens.Type@@ -24,6 +31,9 @@ import Control.Lens.Fold import Control.Lens.Iso import Control.Lens.Prism+#if __GLASGOW_HASKELL__ >= 710+import Control.Lens.Review+#endif import Control.Lens.Setter import Control.Lens.Traversal import Data.ByteString.Lazy as ByteString@@ -137,3 +147,8 @@ utf8 :: Prism' ByteString Text utf8 = prism' encodeUtf8 (preview _Right . decodeUtf8') {-# INLINE utf8 #-}++#if __GLASGOW_HASKELL__ >= 710+pattern Text a <- (view _Text -> a) where+ Text a = review _Text a+#endif
src/Data/Text/Lens.hs view
@@ -2,6 +2,11 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeSynonymInstances #-}++#if __GLASGOW_HASKELL__ >= 710+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE PatternSynonyms #-}+#endif ----------------------------------------------------------------------------- -- | -- Module : Data.Text.Lens@@ -16,9 +21,16 @@ ( IsText(..) , unpacked , _Text+#if __GLASGOW_HASKELL__ >= 710+ , pattern Text+#endif ) where import Control.Lens.Type+#if __GLASGOW_HASKELL__ >= 710+import Control.Lens.Getter+import Control.Lens.Review+#endif import Control.Lens.Iso import Control.Lens.Traversal import Data.Text as Strict@@ -93,6 +105,11 @@ _Text :: IsText t => Iso' t String _Text = from packed {-# INLINE _Text #-}++#if __GLASGOW_HASKELL__ >= 710+pattern Text a <- (view _Text -> a) where+ Text a = review _Text a+#endif instance IsText Strict.Text where packed = Strict.packed
src/Data/Text/Strict/Lens.hs view
@@ -1,5 +1,9 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-}+#if __GLASGOW_HASKELL__ >= 710+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE ViewPatterns #-}+#endif ----------------------------------------------------------------------------- -- | -- Module : Data.Text.Strict.Lens@@ -16,6 +20,9 @@ , text , utf8 , _Text+#if __GLASGOW_HASKELL__ >= 710+ , pattern Text+#endif ) where import Control.Lens.Type@@ -23,6 +30,9 @@ import Control.Lens.Fold import Control.Lens.Iso import Control.Lens.Prism+#if __GLASGOW_HASKELL__ >= 710+import Control.Lens.Review+#endif import Control.Lens.Setter import Control.Lens.Traversal import Data.ByteString (ByteString)@@ -130,3 +140,8 @@ utf8 :: Prism' ByteString Text utf8 = prism' encodeUtf8 (preview _Right . decodeUtf8') {-# INLINE utf8 #-}++#if __GLASGOW_HASKELL__ >= 710+pattern Text a <- (view _Text -> a) where+ Text a = review _Text a+#endif
src/Numeric/Lens.hs view
@@ -1,4 +1,9 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-}+#if __GLASGOW_HASKELL__ >= 710+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE ViewPatterns #-}+#endif -------------------------------------------------------------------------------- -- | -- Module : Numeric.Lens@@ -23,6 +28,9 @@ , dividing , exponentiating , negated+#if __GLASGOW_HASKELL__ >= 710+ , pattern Integral+#endif ) where import Control.Lens@@ -44,6 +52,11 @@ if toInteger a == i then Right a else Left i++#if __GLASGOW_HASKELL__ >= 710+pattern Integral a <- (preview integral -> Just a) where+ Integral a = review integral a+#endif -- | A prism that shows and reads integers in base-2 through base-36 --
src/System/Exit/Lens.hs view
@@ -2,6 +2,11 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} +#if __GLASGOW_HASKELL__ >= 710+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE ViewPatterns #-}+#endif+ #ifndef MIN_VERSION_base #define MIN_VERSION_base(x,y,z) 1 #endif@@ -21,6 +26,10 @@ ( AsExitCode(..) , _ExitFailure , _ExitSuccess+#if __GLASGOW_HASKELL__ >= 710+ , pattern ExitFailure_+ , pattern ExitSuccess_+#endif ) where import Control.Exception@@ -33,19 +42,14 @@ #endif -- | Exit codes that a program can return with:-class AsExitCode p f t where- -- |- -- @- -- '_ExitCode' :: 'Equality'' 'ExitCode' 'ExitCode'- -- '_ExitCode' :: 'Prism'' 'SomeException' 'ExitCode'- -- @- _ExitCode :: Optic' p f t ExitCode+class AsExitCode t where+ _ExitCode :: Prism' t ExitCode -instance AsExitCode p f ExitCode where+instance AsExitCode ExitCode where _ExitCode = id {-# INLINE _ExitCode #-} -instance (Choice p, Applicative f) => AsExitCode p f SomeException where+instance AsExitCode SomeException where _ExitCode = exception {-# INLINE _ExitCode #-} @@ -55,20 +59,29 @@ -- '_ExitSuccess' :: 'Prism'' 'ExitCode' () -- '_ExitSuccess' :: 'Prism'' 'SomeException' () -- @-_ExitSuccess :: (AsExitCode p f t, Choice p, Applicative f) => Optic' p f t ()+_ExitSuccess :: AsExitCode t => Prism' t () _ExitSuccess = _ExitCode . dimap seta (either id id) . right' . rmap (ExitSuccess <$) where seta ExitSuccess = Right () seta t = Left (pure t) {-# INLINE _ExitSuccess #-} + -- | indicates program failure with an exit code. The exact interpretation of the code is operating-system dependent. In particular, some values may be prohibited (e.g. 0 on a POSIX-compliant system). -- -- @ -- '_ExitFailure' :: 'Prism'' 'ExitCode' 'Int' -- '_ExitFailure' :: 'Prism'' 'SomeException' 'Int' -- @-_ExitFailure :: (AsExitCode p f t, Choice p, Applicative f) => Optic' p f t Int+_ExitFailure :: AsExitCode t => Prism' t Int _ExitFailure = _ExitCode . dimap seta (either id id) . right' . rmap (fmap ExitFailure) where seta (ExitFailure i) = Right i seta t = Left (pure t) {-# INLINE _ExitFailure #-}++#if __GLASGOW_HASKELL__ >= 710+pattern ExitSuccess_ <- (has _ExitSuccess -> True) where+ ExitSuccess_ = review _ExitSuccess ()++pattern ExitFailure_ a <- (preview _ExitFailure -> Just a) where+ ExitFailure_ a = review _ExitFailure a+#endif