lens 4.15.4 → 4.16

raw patch · 18 files changed

+496/−65 lines, 18 filesdep ~doctestdep ~freedep ~natsPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: doctest, free, nats, template-haskell

API changes (from Hackage documentation)

Files

• .travis.yml +114/−42
• CHANGELOG.markdown +35/−0
• README.markdown +1/−1
• cabal.project +2/−0
• examples/lens-examples.cabal +5/−3
• lens-properties/CHANGELOG.markdown +4/−0
• lens.cabal +8/−3
• src/Control/Lens/Combinators.hs +10/−2
• src/Control/Lens/Fold.hs +44/−0
• src/Control/Lens/Internal/Fold.hs +29/−6
• src/Control/Lens/Internal/Indexed.hs +24/−0
• src/Control/Lens/Internal/Zoom.hs +2/−2
• src/Control/Lens/Iso.hs +6/−0
• src/Control/Lens/Reified.hs +3/−0
• src/Control/Lens/Traversal.hs +6/−6
• src/Control/Lens/Unsound.hs +93/−0
• src/Language/Haskell/TH/Lens.hs +17/−0
• src/Numeric/Natural/Lens.hs +93/−0

@@ -1,6 +1,6 @@ # This Travis job script has been generated by a script via #-#   make_travis_yml_2.hs 'lens.cabal'+#   runghc make_travis_yml_2.hs '-o' '.travis.yml' '--irc-channel=irc.freenode.org#haskell-lens' '--no-no-tests-no-bench' '--no-installed' 'cabal.project' # # For more information, see https://github.com/hvr/multi-ghc-travis #@@ -10,6 +10,14 @@ git:   submodules: false  # whether to recursively clone submodules +notifications:+  irc:+    channels:+      - "irc.freenode.org#haskell-lens"+    skip_join: true+    template:+      - "\x0313lens\x03/\x0306%{branch}\x03 \x0314%{commit}\x03 %{build_url} %{message}"+ cache:   directories:     - $HOME/.cabal/packages@@ -24,70 +32,134 @@   - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar   - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx +  - rm -rfv $HOME/.cabal/packages/head.hackage+ addons:   apt:     packages: &apt_packages       - ghc-ppa-tools+      - freeglut3-dev       - alex-3.1.7       - happy-1.19.5  matrix:   include:-    - compiler: "ghc-8.2.1"-    # env: TEST=--disable-tests BENCH=--disable-benchmarks-      addons: {apt: {packages: [*apt_packages,cabal-install-2.0,ghc-8.2.1], sources: [hvr-ghc]}}-    - compiler: "ghc-8.0.2"+    - compiler: "ghc-7.4.2"     # env: TEST=--disable-tests BENCH=--disable-benchmarks-      addons: {apt: {packages: [*apt_packages,cabal-install-2.0,ghc-8.0.2], sources: [hvr-ghc]}}-    - compiler: "ghc-7.10.3"+      addons: {apt: {packages: [*apt_packages,cabal-install-2.0,ghc-7.4.2], sources: [hvr-ghc]}}+    - compiler: "ghc-7.6.3"     # env: TEST=--disable-tests BENCH=--disable-benchmarks-      addons: {apt: {packages: [*apt_packages,cabal-install-2.0,ghc-7.10.3], sources: [hvr-ghc]}}+      addons: {apt: {packages: [*apt_packages,cabal-install-2.0,ghc-7.6.3], sources: [hvr-ghc]}}     - compiler: "ghc-7.8.4"     # env: TEST=--disable-tests BENCH=--disable-benchmarks       addons: {apt: {packages: [*apt_packages,cabal-install-2.0,ghc-7.8.4], sources: [hvr-ghc]}}-    - compiler: "ghc-7.6.3"+    - compiler: "ghc-7.10.3"     # env: TEST=--disable-tests BENCH=--disable-benchmarks-      addons: {apt: {packages: [*apt_packages,cabal-install-2.0,ghc-7.6.3], sources: [hvr-ghc]}}-    - compiler: "ghc-7.4.2"+      addons: {apt: {packages: [*apt_packages,cabal-install-2.0,ghc-7.10.3], sources: [hvr-ghc]}}+    - compiler: "ghc-8.0.2"     # env: TEST=--disable-tests BENCH=--disable-benchmarks-      addons: {apt: {packages: [*apt_packages,cabal-install-2.0,ghc-7.4.2], sources: [hvr-ghc]}}+      addons: {apt: {packages: [*apt_packages,cabal-install-2.0,ghc-8.0.2], sources: [hvr-ghc]}}+    - compiler: "ghc-8.2.2"+    # env: TEST=--disable-tests BENCH=--disable-benchmarks+      addons: {apt: {packages: [*apt_packages,cabal-install-2.0,ghc-8.2.2], sources: [hvr-ghc]}}+    - compiler: "ghc-8.4.1"+      env: GHCHEAD=true+      addons: {apt: {packages: [*apt_packages,cabal-install-head,ghc-8.4.1], sources: [hvr-ghc]}}+    - compiler: "ghc-head"+      env: GHCHEAD=true+      addons: {apt: {packages: [*apt_packages,cabal-install-head,ghc-head], sources: [hvr-ghc]}} +  allow_failures:+    - compiler: "ghc-8.4.1"+    - compiler: "ghc-head"+ before_install:- - HC=${CC}- - unset CC- - export HAPPYVER=1.19.5- - export ALEXVER=3.1.7- - export HLINTVER=2.0.9- - mkdir ~/.hlint- - curl -L https://github.com/ndmitchell/hlint/releases/download/v$HLINTVER/hlint-$HLINTVER-x86_64-linux.tar.gz | tar -xz --strip-components=1 -C ~/.hlint- - PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:~/.hlint:~/.cabal/bin:/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:/opt/happy/$HAPPYVER/bin:/opt/alex/$ALEXVER/bin:$PATH+  - HC=${CC}+  - HCPKG=${HC/ghc/ghc-pkg}+  - unset CC+  - export HAPPYVER=1.19.5+  - export ALEXVER=3.1.7+  - export HLINTVER=2.0.9+  - mkdir ~/.hlint+  - curl -L https://github.com/ndmitchell/hlint/releases/download/v$HLINTVER/hlint-$HLINTVER-x86_64-linux.tar.gz | tar -xz --strip-components=1 -C ~/.hlint+  - ROOTDIR=$(pwd)+  - mkdir -p $HOME/.local/bin+  - "PATH=~/.hlint:/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$HOME/local/bin:/opt/happy/$HAPPYVER/bin:/opt/alex/$ALEXVER/bin:$PATH"+  - HCNUMVER=$(( $(${HC} --numeric-version|sed -E 's/([0-9]+)\.([0-9]+)\.([0-9]+).*/\1 * 10000 + \2 * 100 + \3/') ))+  - echo $HCNUMVER  install:- - cabal --version- - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"- - BENCH=${BENCH---enable-benchmarks}- - TEST=${TEST---enable-tests}- - travis_retry cabal update -v- - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config- - rm -fv cabal.project.local- - rm -f cabal.project.freeze- - cabal new-build -w ${HC} ${TEST} ${BENCH} --dep -j+  - cabal --version+  - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"+  - BENCH=${BENCH---enable-benchmarks}+  - TEST=${TEST---enable-tests}+  - HADDOCK=${HADDOCK-true}+  - INSTALLED=${INSTALLED-true}+  - GHCHEAD=${GHCHEAD-false}+  - travis_retry cabal update -v+  - "sed -i.bak 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config"+  - rm -fv cabal.project cabal.project.local+  # Overlay Hackage Package Index for GHC HEAD: https://github.com/hvr/head.hackage+  - |+    if $GHCHEAD; then+      sed -i.bak 's/-- allow-newer:.*/allow-newer: *:base, *:template-haskell, *:ghc, *:Cabal/' ${HOME}/.cabal/config +      echo 'repository head.hackage'                                                        >> ${HOME}/.cabal/config+      echo '   url: http://head.hackage.haskell.org/'                                       >> ${HOME}/.cabal/config+      echo '   secure: True'                                                                >> ${HOME}/.cabal/config+      echo '   root-keys: 07c59cb65787dedfaef5bd5f987ceb5f7e5ebf88b904bbd4c5cbdeb2ff71b740' >> ${HOME}/.cabal/config+      echo '              2e8555dde16ebd8df076f1a8ef13b8f14c66bad8eafefd7d9e37d0ed711821fb' >> ${HOME}/.cabal/config+      echo '              8f79fd2389ab2967354407ec852cbe73f2e8635793ac446d09461ffb99527f6e' >> ${HOME}/.cabal/config+      echo '   key-threshold: 3'                                                            >> ${HOME}/.cabal.config++      cabal new-update head.hackage -v+    fi+  - grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$'+  - "printf 'packages: \".\" \"./examples\" \"./lens-properties\"\\n' > cabal.project"+  - cat cabal.project+  - if [ -f "./configure.ac" ]; then+      (cd "." && autoreconf -i);+    fi+  - if [ -f "./examples/configure.ac" ]; then+      (cd "./examples" && autoreconf -i);+    fi+  - if [ -f "./lens-properties/configure.ac" ]; then+      (cd "./lens-properties" && autoreconf -i);+    fi+  - rm -f cabal.project.freeze+  - cabal new-build -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dep -j2 all+  - rm -rf "."/.ghc.environment.* "./examples"/.ghc.environment.* "./lens-properties"/.ghc.environment.* "."/dist "./examples"/dist "./lens-properties"/dist+  - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)+ # 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:- - if [ -f configure.ac ]; then autoreconf -i; fi- - rm -rf .ghc.environment.* dist/- # build tests and benchmarks, run tests- - cabal new-build -w ${HC} ${TEST} ${BENCH}- - if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} ${BENCH}; fi- - hlint src --cpp-define=HLINT --cpp-ansi+  # test that source-distributions can be generated+  - (cd "." && cabal sdist)+  - (cd "./examples" && cabal sdist)+  - (cd "./lens-properties" && cabal sdist)+  - mv "."/dist/lens-*.tar.gz "./examples"/dist/lens-examples-*.tar.gz "./lens-properties"/dist/lens-properties-*.tar.gz ${DISTDIR}/+  - cd ${DISTDIR} || false+  - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \;+  - "printf 'packages: lens-*/*.cabal lens-examples-*/*.cabal lens-properties-*/*.cabal\\n' > cabal.project"+  - cat cabal.project -notifications:-  irc:-    channels:-      - "irc.freenode.org#haskell-lens"-    skip_join: true-    template:-      - "\x0313lens\x0f/\x0306%{branch}\x0f \x0314%{commit}\x0f %{message} \x0302\x1f%{build_url}\x0f"++  # build & run tests, build benchmarks+  - cabal new-build -w ${HC} ${TEST} ${BENCH} all+  - if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} ${BENCH} all; fi++  # cabal check+  - (cd lens-* && cabal check)+  - (cd lens-examples-* && cabal check)+  - (cd lens-properties-* && cabal check)++  # haddock+  - rm -rf ./dist-newstyle+  - if $HADDOCK; then cabal new-haddock -w ${HC} ${TEST} ${BENCH} all; else echo "Skipping haddock generation";fi++  # hlint+  - (cd lens-* && hlint src --cpp-define=HLINT --cpp-ansi)++# REGENDATA ["-o",".travis.yml","--irc-channel=irc.freenode.org#haskell-lens","--no-no-tests-no-bench","--no-installed","cabal.project"] # EOF

@@ -1,3 +1,38 @@+4.16 [2018.01.28]+-----------------+* The `Semigroup` instances for `Traversed` and `Sequenced` are now more+  constrained (going from `Apply` to `Applicative` and `Monad`, respectively).+  In GHC 8.4, `Semigroup` is a superclass of `Monoid`, therefore we'd need to+  have `Apply` constraint in the `Monoid` instances. We opted to weaken our+  ability to use `Apply` than to lose compatibility with third-party packages+  that don't supply instances for `Apply`.++  In practice this changes the (specialised) type signature of `traverseOf_`+  ```diff++  - traverseOf_ :: Apply f       => Fold1 s a -> (a -> f r) -> s -> f ()+  + traverseOf_ :: Applicative f => Fold1 s a -> (a -> f r) -> s -> f ()+  ```+  and similarly for `forOf_` and `sequenceOf_`.++  As part of this change, new combinators `traverse1Of_`, `for1Of_` and+  `sequence1Of_` were added for `Apply`-only effects.++  Similar instance context changes were made for `Folding` and `Effect`,+  but these changes aren't publicly visible.++* Add `Control.Lens.Unsound`, which exports unsound functionality for forming+  products of lenses and sums of prisms.++* Add `Numeric.Natural.Lens`, which export convenient isomorphisms for+  natural numbers.++* Add `Strict` instances for strict and lazy `ST`.++* Adapt `Language.Haskell.TH.Lens` for `template-haskell-2.13` (bundled+  with GHC 8.4).++* Add `Semigroup` and `Monoid` instances for `Indexing`.+ 4.15.4 ---- * `makeFields` and `declareFields` are now smarter with respect to type

@@ -1,7 +1,7 @@ Lens: Lenses, Folds, and Traversals ================================== -[![Hackage](https://img.shields.io/hackage/v/lens.svg)](https://hackage.haskell.org/package/lens) [![Build Status](https://secure.travis-ci.org/ekmett/lens.svg)](http://travis-ci.org/ekmett/lens)+[![Hackage](https://img.shields.io/hackage/v/lens.svg)](https://hackage.haskell.org/package/lens) [![Build Status](https://secure.travis-ci.org/ekmett/lens.svg)](http://travis-ci.org/ekmett/lens) [![Hackage Deps](https://img.shields.io/hackage-deps/v/lens.svg)](http://packdeps.haskellers.com/reverse/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). 

@@ -1,1 +1,3 @@ packages: .+          ./examples+          ./lens-properties

@@ -11,10 +11,12 @@ bug-reports:   http://github.com/ekmett/lens/issues copyright:     Copyright (C) 2012 Edward A. Kmett synopsis:      Lenses, Folds and Traversals-description:   Pong Example+description:   Lenses, Folds and Traversals+               .+               Pong Example  build-type:    Simple-tested-with:   GHC == 7.4.1+tested-with:   GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.1  source-repository head   type: git@@ -28,7 +30,7 @@     buildable: False    build-depends:-    base,+    base       >= 4.5   && < 5,     containers >= 0.4   && < 0.6,     gloss      >= 1.7   && < 1.12,     lens,

@@ -1,3 +1,7 @@+4.11.1+------+* Update version bounds.+ 4.0 --- 

@@ -1,6 +1,6 @@ name:          lens category:      Data, Lenses, Generics-version:       4.15.4+version:       4.16 license:       BSD2 cabal-version: >= 1.8 license-file:  LICENSE@@ -12,7 +12,7 @@ copyright:     Copyright (C) 2012-2016 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.3, GHC == 8.0.2, GHC == 8.2.1+tested-with:   GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.1 synopsis:      Lenses, Folds and Traversals description:   This package comes \"Batteries Included\" with many useful lenses for the types@@ -195,7 +195,7 @@     containers                >= 0.4.0    && < 0.6,     distributive              >= 0.3      && < 1,     filepath                  >= 1.2.0.0  && < 1.5,-    free                      >= 4        && < 5,+    free                      >= 4        && < 6,     ghc-prim,     hashable                  >= 1.1.2.3  && < 1.3,     kan-extensions            >= 5        && < 6,@@ -219,6 +219,9 @@   if impl(ghc < 8.0)     build-depends: generic-deriving >= 1.10 && < 2 +  if impl(ghc < 7.9)+    build-depends: nats >= 0.1 && < 1.2+   exposed-modules:     Control.Exception.Lens     Control.Lens@@ -268,6 +271,7 @@     Control.Lens.Traversal     Control.Lens.Tuple     Control.Lens.Type+    Control.Lens.Unsound     Control.Lens.Wrapped     Control.Lens.Zoom     Control.Monad.Error.Lens@@ -300,6 +304,7 @@     System.IO.Error.Lens     Language.Haskell.TH.Lens     Numeric.Lens+    Numeric.Natural.Lens    other-modules:     Paths_lens

@@ -1,3 +1,4 @@+{-# Language CPP #-} -------------------------------------------------------------------------------- -- | -- Module      :  Control.Lens.Combinators@@ -18,8 +19,7 @@     ) where  import Control.Lens hiding-  ( -- output from scripts/operators-    (<|)+  ( (<|)   , (|>)   , (^..)   , (^?)@@ -91,6 +91,8 @@   , (%%@=)   , (<%@=)   , (<<%@=)+  , (.@=)+  , (.@~)   , (^#)   , ( #~ )   , ( #%~ )@@ -109,6 +111,8 @@   , (?~)   , (<.~)   , (<?~)+  , (<<?~)+  , (<<?=)   , (+~)   , (*~)   , (-~)@@ -137,4 +141,8 @@   , (<>=)   , (%@~)   , (%@=)+#if __GLASGOW_HASKELL__ >= 710+  , (:>)+  , (:<)+#endif   )

@@ -83,6 +83,7 @@   , andOf, orOf   , productOf, sumOf   , traverseOf_, forOf_, sequenceAOf_+  , traverse1Of_, for1Of_, sequence1Of_   , mapMOf_, forMOf_, sequenceOf_   , asumOf, msumOf   , concatMapOf, concatOf@@ -193,6 +194,7 @@ -- >>> import Control.Exception (evaluate) -- >>> import Data.Maybe (fromMaybe) -- >>> import System.Timeout (timeout)+-- >>> import qualified Data.Map as Map -- >>> let f :: Expr -> Expr; f = Debug.SimpleReflect.Vars.f -- >>> let g :: Expr -> Expr; g = Debug.SimpleReflect.Vars.g -- >>> let timingOut :: NFData a => a -> IO a; timingOut = fmap (fromMaybe (error "timeout")) . timeout (5*10^6) . evaluate . force@@ -950,6 +952,48 @@ sequenceAOf_ :: Functor f => Getting (Traversed a f) s (f a) -> s -> f () sequenceAOf_ l = void . getTraversed #. foldMapOf l Traversed {-# INLINE sequenceAOf_ #-}++-- | Traverse over all of the targets of a 'Fold1', computing an 'Apply' based answer.+--+-- As long as you have 'Applicative' or 'Functor' effect you are better using 'traverseOf_'.+-- The 'traverse1Of_' is useful only when you have genuine 'Apply' effect.+--+-- >>> traverse1Of_ both1 (\ks -> Map.fromList [ (k, ()) | k <- ks ]) ("abc", "bcd")+-- fromList [('b',()),('c',())]+--+-- @+-- 'traverse1Of_' :: 'Apply' f => 'Fold1' s a -> (a -> f r) -> s -> f ()+-- @+--+-- @since 4.16+traverse1Of_ :: Functor f => Getting (TraversedF r f) s a -> (a -> f r) -> s -> f ()+traverse1Of_ l f = void . getTraversedF #. foldMapOf l (TraversedF #. f)+{-# INLINE traverse1Of_ #-}++-- | See 'forOf_' and 'traverse1Of_'.+--+-- >>> for1Of_ both1 ("abc", "bcd") (\ks -> Map.fromList [ (k, ()) | k <- ks ])+-- fromList [('b',()),('c',())]+--+-- @+-- 'for1Of_' :: 'Apply' f => 'Fold1' s a -> s -> (a -> f r) -> f ()+-- @+--+-- @since 4.16+for1Of_ :: Functor f => Getting (TraversedF r f) s a -> s -> (a -> f r) -> f ()+for1Of_ = flip . traverse1Of_+{-# INLINE for1Of_ #-}++-- | See 'sequenceAOf_' and 'traverse1Of_'.+--+-- @+-- 'sequence1Of_' :: 'Apply' f => 'Fold1' s (f a) -> s -> f ()+-- @+--+-- @since 4.16+sequence1Of_ :: Functor f => Getting (TraversedF a f) s (f a) -> s -> f ()+sequence1Of_ l = void . getTraversedF #. foldMapOf l TraversedF+{-# INLINE sequence1Of_ #-}  -- | Map each target of a 'Fold' on a structure to a monadic action, evaluate these actions from left to right, and ignore the results. --

@@ -21,6 +21,7 @@   -- * Monoids for folding     Folding(..)   , Traversed(..)+  , TraversedF(..)   , Sequenced(..)   , Max(..), getMax   , Min(..), getMin@@ -53,8 +54,8 @@ -- | A 'Monoid' for a 'Contravariant' 'Applicative'. newtype Folding f a = Folding { getFolding :: f a } -instance (Contravariant f, Apply f) => Semigroup (Folding f a) where-  Folding fr <> Folding fs = Folding (fr .> fs)+instance (Contravariant f, Applicative f) => Semigroup (Folding f a) where+  Folding fr <> Folding fs = Folding (fr *> fs)   {-# INLINE (<>) #-}  instance (Contravariant f, Applicative f) => Monoid (Folding f a) where@@ -72,8 +73,9 @@ -- The argument 'a' of the result should not be used! newtype Traversed a f = Traversed { getTraversed :: f a } -instance Apply f => Semigroup (Traversed a f) where-  Traversed ma <> Traversed mb = Traversed (ma .> mb)+-- See 4.16 Changelog entry for the explanation of "why not Apply f =>"?+instance Applicative f => Semigroup (Traversed a f) where+  Traversed ma <> Traversed mb = Traversed (ma *> mb)   {-# INLINE (<>) #-}  instance Applicative f => Monoid (Traversed a f) where@@ -83,16 +85,37 @@   {-# INLINE mappend #-}  ------------------------------------------------------------------------------+-- TraversedF+------------------------------------------------------------------------------++-- | Used internally by 'Control.Lens.Fold.traverse1Of_' and the like.+--+-- @since 4.16+newtype TraversedF a f = TraversedF { getTraversedF :: f a }++instance Apply f => Semigroup (TraversedF a f) where+  TraversedF ma <> TraversedF mb = TraversedF (ma .> mb)+  {-# INLINE (<>) #-}++instance (Apply f, Applicative f) => Monoid (TraversedF a f) where+  mempty = TraversedF (pure (error "TraversedF: value used"))+  {-# INLINE mempty #-}+  TraversedF ma `mappend` TraversedF mb = TraversedF (ma *> mb)+  {-# INLINE mappend #-}++------------------------------------------------------------------------------ -- Sequenced ------------------------------------------------------------------------------  -- | Used internally by 'Control.Lens.Traversal.mapM_' and the like. -- -- The argument 'a' of the result should not be used!+--+-- See 4.16 Changelog entry for the explanation of "why not Apply f =>"? newtype Sequenced a m = Sequenced { getSequenced :: m a } -instance Apply m => Semigroup (Sequenced a m) where-  Sequenced ma <> Sequenced mb = Sequenced (ma .> mb)+instance Monad m => Semigroup (Sequenced a m) where+  Sequenced ma <> Sequenced mb = Sequenced (ma >> mb)   {-# INLINE (<>) #-}  instance Monad m => Monoid (Sequenced a m) where

@@ -50,10 +50,12 @@ import Data.Functor.Bind import Data.Functor.Contravariant import Data.Int+import Data.Monoid import Data.Profunctor.Closed import Data.Profunctor import Data.Profunctor.Rep import Data.Profunctor.Sieve+import qualified Data.Semigroup as Semi import Data.Traversable import Prelude hiding ((.),id) #ifndef SAFE@@ -275,6 +277,28 @@   contramap f (Indexing m) = Indexing $ \i -> case m i of     (j, ff) -> (j, contramap f ff)   {-# INLINE contramap #-}++instance Semi.Semigroup (f a) => Semi.Semigroup (Indexing f a) where+    Indexing mx <> Indexing my = Indexing $ \i -> case mx i of+      (j, x) -> case my j of+         ~(k, y) -> (k, x Semi.<> y)+    {-# INLINE (<>) #-}++-- |+--+-- >>> "cat" ^@.. (folded <> folded)+-- [(0,'c'),(1,'a'),(2,'t'),(0,'c'),(1,'a'),(2,'t')]+--+-- >>> "cat" ^@.. indexing (folded <> folded)+-- [(0,'c'),(1,'a'),(2,'t'),(3,'c'),(4,'a'),(5,'t')]+instance Monoid (f a) => Monoid (Indexing f a) where+    mempty = Indexing $ \i -> (i, mempty)+    {-# INLINE mempty #-}++    mappend (Indexing mx) (Indexing my) = Indexing $ \i -> case mx i of+      (j, x) -> case my j of+         ~(k, y) -> (k, mappend x y)+    {-# INLINE mappend #-}  -- | Transform a 'Control.Lens.Traversal.Traversal' into an 'Control.Lens.Traversal.IndexedTraversal' or -- a 'Control.Lens.Fold.Fold' into an 'Control.Lens.Fold.IndexedFold', etc.

@@ -287,8 +287,8 @@   contramap _ (Effect m) = Effect m   {-# INLINE contramap #-} -instance (Apply m, Semigroup r) => Semigroup (Effect m r a) where-  Effect ma <> Effect mb = Effect (liftF2 (<>) ma mb)+instance (Monad m, Semigroup r) => Semigroup (Effect m r a) where+  Effect ma <> Effect mb = Effect (liftM2 (<>) ma mb)   {-# INLINE (<>) #-}  instance (Monad m, Monoid r) => Monoid (Effect m r a) where

@@ -104,6 +104,8 @@ import Control.Monad.Writer.Strict as Strict import Control.Monad.RWS.Lazy as Lazy import Control.Monad.RWS.Strict as Strict+import Control.Monad.ST.Lazy as Lazy+import Control.Monad.ST as Strict import Data.Bifunctor import Data.ByteString as StrictB hiding (reverse) import Data.ByteString.Lazy as LazyB hiding (reverse)@@ -449,6 +451,10 @@  instance Strict (Lazy.RWST r w s m a) (Strict.RWST r w s m a) where   strict = iso (Strict.RWST . Lazy.runRWST) (Lazy.RWST . Strict.runRWST)+  {-# INLINE strict #-}++instance Strict (Lazy.ST s a) (Strict.ST s a) where+  strict = iso Lazy.lazyToStrictST Lazy.strictToLazyST   {-# INLINE strict #-}  -- | An 'Iso' between the strict variant of a structure and its lazy

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-}@@ -37,7 +38,9 @@ import Data.Profunctor import Data.Profunctor.Rep import Data.Profunctor.Sieve+#if !(MIN_VERSION_base(4,11,0)) import Data.Semigroup+#endif  -- $setup -- >>> import Control.Lens

@@ -230,11 +230,11 @@ -- --  * a 'Traversal' if @f@ is 'Applicative', -----  * a 'Getter' if @f@ is only a 'Functor' and 'Contravariant',+--  * a 'Getter' if @f@ is only a 'Functor' and 'Data.Functor.Contravariant.Contravariant', -----  * a 'Lens' if @p@ is only a 'Functor',+--  * a 'Lens' if @f@ is only a 'Functor', -----  * a 'Fold' if @f@ is 'Functor', 'Contravariant' and 'Applicative'.+--  * a 'Fold' if @f@ is 'Applicative' and 'Data.Functor.Contravariant.Contravariant'. type Traversing p f s t a b = Over p (BazaarT p f a b) s t a b  type Traversing1 p f s t a b = Over p (BazaarT1 p f a b) s t a b@@ -606,7 +606,7 @@ -- Given a context you can use 'Control.Comonad.Store.Class.pos' to see the values, 'Control.Comonad.Store.Class.peek' at what the structure would be like with an edited result, or simply 'extract' the original structure. -- -- @--- propChildren l x = childrenOf l x '==' 'map' 'Control.Comonad.Store.Class.pos' ('holesOf' l x)+-- propChildren l x = 'toListOf' l x '==' 'map' 'Control.Comonad.Store.Class.pos' ('holesOf' l x) -- propId l x = 'all' ('==' x) ['extract' w | w <- 'holesOf' l x] -- @ --@@ -1274,9 +1274,9 @@ deepOf :: (Conjoined p, Applicative f) => LensLike f s t s t -> Traversing p f s t a b -> Over p f s t a b deepOf r l = failing l (r . deepOf r l) --- | "Fuse" a 'Traversal' by reassociating all of the '\<*\>' operations to the+-- | "Fuse" a 'Traversal' by reassociating all of the '<*>' operations to the -- left and fusing all of the 'fmap' calls into one. This is particularly--- useful when constructing a 'Traversal' using operations from GHC.Generics.+-- useful when constructing a 'Traversal' using operations from "GHC.Generics". -- -- Given a pair of 'Traversal's 'foo' and 'bar', --

@@ -0,0 +1,93 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}++#ifndef MIN_VERSION_mtl+#define MIN_VERSION_mtl(x,y,z) 1+#endif++#if __GLASGOW_HASKELL__ < 708+{-# LANGUAGE Trustworthy #-}+#endif++{-# LANGUAGE RankNTypes #-}++-------------------------------------------------------------------------------+-- |+-- Module      :  Control.Lens.Unsound+-- Copyright   :  (C) 2012-16 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  Rank2Types+--+-- One commonly asked question is: can we combine two lenses,+-- @`Lens'` a b@ and @`Lens'` a c@ into @`Lens'` a (b, c)@.+-- This is fair thing to ask, but such operation is unsound in general. +-- See `lensProduct`.+--+-------------------------------------------------------------------------------+module Control.Lens.Unsound+  ( +    lensProduct+  , prismSum+  ) where++import Control.Applicative+import Control.Lens+import Prelude++-- | A lens product. There is no law-abiding way to do this in general.+-- Result is only a valid 'Lens' if the input lenses project disjoint parts of +-- the structure @s@. Otherwise "you get what you put in" law+--+-- @+-- 'Control.Lens.Getter.view' l ('Control.Lens.Setter.set' l v s) ≡ v+-- @+--+-- is violated by+--+-- >>> let badLens :: Lens' (Int, Char) (Int, Int); badLens = lensProduct _1 _1+-- >>> view badLens (set badLens (1,2) (3,'x'))+-- (2,2)+--+-- but we should get @(1,2)@.+--+-- Are you looking for 'Control.Lens.Lens.alongside'?+--+lensProduct :: ALens' s a -> ALens' s b -> Lens' s (a, b)+lensProduct l1 l2 f s =+    f (s ^# l1, s ^# l2) <&> \(a, b) -> s & l1 #~ a & l2 #~ b++-- | A dual of `lensProduct`: a prism sum.+--+-- The law+--+-- @+-- 'Control.Lens.Fold.preview' l ('Control.Lens.Review.review' l b) ≡ 'Just' b+-- @+--+-- breaks with+--+-- >>> let badPrism :: Prism' (Maybe Char) (Either Char Char); badPrism = prismSum _Just _Just+-- >>> preview badPrism (review badPrism (Right 'x'))+-- Just (Left 'x')+--+-- We put in 'Right' value, but get back 'Left'.+-- +-- Are you looking for 'Control.Lens.Prism.without'?+--+prismSum :: APrism s t a b+         -> APrism s t c d+         -> Prism s t (Either a c) (Either b d)+prismSum k =+    withPrism k                  $ \bt seta k' ->+    withPrism k'                 $ \dt setb    ->+    prism (either bt dt) $ \s ->+    f (Left <$> seta s) (Right <$> setb s)+  where+    f a@(Right _) _ = a+    f (Left _)    b = b 

@@ -229,9 +229,11 @@ #endif   -- ** FunDep Prisms TODO make a lens   , _FunDep+#if !(MIN_VERSION_template_haskell(2,13,0))   -- ** FamFlavour Prisms   , _TypeFam   , _DataFam+#endif   -- ** FixityDirection Prisms   , _InfixL   , _InfixR@@ -275,6 +277,9 @@ #if MIN_VERSION_template_haskell(2,11,0)   , _UnboundVarE #endif+#if MIN_VERSION_template_haskell(2,13,0)+  , _LabelE+#endif   -- ** Body Prisms   , _GuardedB   , _NormalB@@ -1689,6 +1694,7 @@       reviewer (x, y) = FunDep x y       remitter (FunDep x y) = (x, y) +#if !(MIN_VERSION_template_haskell(2,13,0)) _TypeFam :: Prism' FamFlavour () _TypeFam   = prism' reviewer remitter@@ -1704,6 +1710,7 @@       reviewer () = DataFam       remitter DataFam = Just ()       remitter _ = Nothing+#endif  #if MIN_VERSION_template_haskell(2,9,0) tySynEqnPatterns :: Lens' TySynEqn [Type]@@ -1958,6 +1965,16 @@   where       reviewer = UnboundVarE       remitter (UnboundVarE x) = Just x+      remitter _ = Nothing+#endif++#if MIN_VERSION_template_haskell(2,13,0)+_LabelE :: Prism' Exp String+_LabelE+  = prism' reviewer remitter+  where+      reviewer = LabelE+      remitter (LabelE x) = Just x       remitter _ = Nothing #endif 

@@ -0,0 +1,93 @@+{-# language CPP #-}+{-# language RankNTypes #-}+{-# language PatternGuards #-}+#if __GLASGOW_HASKELL__ >= 710+{-# language ViewPatterns #-}+{-# language PatternSynonyms #-}+#endif+--------------------------------------------------------------------------------+-- |+-- Module      :  Numeric.Natural.Lens+-- Copyright   :  (C) 2017 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+-- Useful tools for Gödel numbering.+-------------------------------------------------------------------------------+module Numeric.Natural.Lens+  ( _Pair+  , _Sum+  , _Naturals+#if __GLASGOW_HASKELL__ >= 710+  , pattern Pair+  , pattern Sum+  , pattern Naturals+#endif+  ) where++import Control.Lens+import Numeric.Natural++-- | The natural numbers are isomorphic to the product of the natural numbers with itself.+--+-- @N = N*N@+_Pair :: Iso' Natural (Natural, Natural)+_Pair = iso hither (uncurry yon) where+  yon 0 0 = 0+  yon m n = case quotRem m 2 of+    (q,r) -> r + 2 * yon n q -- rotation++  hither 0 = (0,0)+  hither n = case quotRem n 2 of+   (p,r) -> case hither p of+     (x,y) -> (r+2*y,x) -- rotation++-- | The natural numbers are isomorphic to disjoint sums of natural numbers embedded as+-- evens or odds.+--+-- @N = 2*N@+_Sum :: Iso' Natural (Either Natural Natural)+_Sum = iso hither yon where+  hither p = case quotRem p 2 of+    (q,0) -> Left q+    (q,1) -> Right q+    _     -> error "_Sum: impossible"+  yon (Left q)  = 2*q+  yon (Right q) = 2*q+1++-- | The natural numbers are isomorphic to lists of natural numbers+_Naturals :: Iso' Natural [Natural]+_Naturals = iso hither yon where+  hither 0 = []+  hither n | (h, t) <- (n-1)^._Pair = h : hither t+  yon [] = 0+  yon (x:xs) = 1 + review _Pair (x, yon xs)++#if __GLASGOW_HASKELL__ >= 710++-- |+-- interleaves the bits of two natural numbers+pattern Pair :: Natural -> Natural -> Natural+pattern Pair x y <- (view _Pair -> (x,y)) where+  Pair x y = review _Pair (x,y)++-- |+-- @+-- Sum (Left q) = 2*q+-- Sum (Right q) = 2*q+1+-- @+pattern Sum :: Either Natural Natural -> Natural+pattern Sum s <- (view _Sum -> s) where+  Sum s = review _Sum s++-- |+-- @+-- Naturals [] = 0+-- Naturals (h:t) = 1 + Pair h (Naturals t)+-- @+pattern Naturals :: [Natural] -> Natural+pattern Naturals xs <- (view _Naturals -> xs) where+  Naturals xs = review _Naturals xs+#endif