Hello community, here is the log from the commit of package ghc-lens for openSUSE:Factory checked in at 2017-03-20 17:07:32 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-lens (Old) and /work/SRC/openSUSE:Factory/.ghc-lens.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-lens" Mon Mar 20 17:07:32 2017 rev:5 rq:477455 version:4.15.1 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-lens/ghc-lens.changes 2016-10-25 17:43:42.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-lens.new/ghc-lens.changes 2017-03-20 17:07:33.230889989 +0100 @@ -1,0 +2,5 @@ +Sun Feb 12 14:08:01 UTC 2017 - [email protected] + +- Update to version 4.15.1 revision 4 with cabal2obs. + +------------------------------------------------------------------- Old: ---- lens-4.14.tar.gz New: ---- lens-4.15.1.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-lens.spec ++++++ --- /var/tmp/diff_new_pack.kQ197l/_old 2017-03-20 17:07:34.314736950 +0100 +++ /var/tmp/diff_new_pack.kQ197l/_new 2017-03-20 17:07:34.318736386 +0100 @@ -1,7 +1,7 @@ # # spec file for package ghc-lens # -# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -19,14 +19,14 @@ %global pkg_name lens %bcond_with tests Name: ghc-%{pkg_name} -Version: 4.14 +Version: 4.15.1 Release: 0 Summary: Lenses, Folds and Traversals License: BSD-3-Clause Group: Development/Languages/Other Url: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz -Source1: https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/1.cabal#/%{pkg_name}.cabal +Source1: https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/4.cabal#/%{pkg_name}.cabal BuildRequires: ghc-Cabal-devel BuildRequires: ghc-array-devel BuildRequires: ghc-base-orphans-devel @@ -60,7 +60,13 @@ %if %{with tests} BuildRequires: ghc-HUnit-devel BuildRequires: ghc-QuickCheck-devel +BuildRequires: ghc-deepseq-devel +BuildRequires: ghc-directory-devel +BuildRequires: ghc-doctest-devel +BuildRequires: ghc-generic-deriving-devel BuildRequires: ghc-hlint-devel +BuildRequires: ghc-nats-devel +BuildRequires: ghc-simple-reflect-devel BuildRequires: ghc-test-framework-devel BuildRequires: ghc-test-framework-hunit-devel BuildRequires: ghc-test-framework-quickcheck2-devel @@ -187,5 +193,6 @@ %files devel -f %{name}-devel.files %defattr(-,root,root,-) +%doc AUTHORS.markdown CHANGELOG.markdown README.markdown examples %changelog ++++++ lens-4.14.tar.gz -> lens-4.15.1.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/lens-4.14/.gitignore new/lens-4.15.1/.gitignore --- old/lens-4.14/.gitignore 2016-04-28 23:10:28.000000000 +0200 +++ new/lens-4.15.1/.gitignore 2016-10-10 05:56:36.000000000 +0200 @@ -1,4 +1,5 @@ dist/ +dist-newstyle/ .hsenv/ docs wiki @@ -12,6 +13,7 @@ *.hi *~ *# +cabal.project.local .cabal-sandbox/ cabal.sandbox.config .stack-work/ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/lens-4.14/CHANGELOG.markdown new/lens-4.15.1/CHANGELOG.markdown --- old/lens-4.14/CHANGELOG.markdown 2016-04-28 23:10:28.000000000 +0200 +++ new/lens-4.15.1/CHANGELOG.markdown 2016-10-10 05:56:36.000000000 +0200 @@ -1,3 +1,18 @@ +4.15.1 +---- +* Restore the `generic` and `generic1` functions in `GHC.Generics.Lens` + +4.15 +---- +* Remove `Generics.Deriving.Lens` module. +* Incorporate `URec`, which was introduced in `GHC.Generics` in `base-4.9`. For compatibility with older versions of `base`, `lens` now conditionally depends on `generic-deriving` +* Add `Rewrapped` instance for `ExceptT` +* Add `FunctorWithIndex`, `FoldableWithIndex`, and `TraversableWithIndex` instances for `Sum`, `Proxy`, `Tagged` and data types in `GHC.Generics` +* Remove unneeded context from `*WithIndex HashMap` instances +* Add `Data.Map.Lens.toMapOf` +* Add moral `Functor` constraint for `to` `ito` `ilike` `ilike` to allow the + "indented" type signature using Getter with redundant warnings turned on. + 4.14 ---- * Remove `Cons` and `Snoc` instances for `NonEmpty`. @@ -277,7 +292,7 @@ * Many performance optimizations. * Switched to `exceptions` from `MonadCatchIO-transformers` * Added types for working with `RelevantFold` and `RelevantTraversal`. These are a `Fold` or `Traversal` that always has at least one target. Since `Apply` isn't a superclass of `Applicative`, you occasionally need to convert between them, but it lets you more readily work with less unsafety. -* Changed `unwrapping` and `wrapping` to have the same constructor-oriented order as a `Prism` and renamed them t `_Wrapping` and `_Unwrapping` respectively. +* Changed `unwrapping` and `wrapping` to have the same constructor-oriented order as a `Prism` and renamed them t `_Wrapping` and `_Unwrapping` respectively. * Drastically changed the way `_Wrapping` and `_Unwrapping` are built to get much better inference. * There are about 15,000 lines of patches over the last year, so I'm sure we missed a few big changes. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/lens-4.14/benchmarks/plated.hs new/lens-4.15.1/benchmarks/plated.hs --- old/lens-4.14/benchmarks/plated.hs 2016-04-28 23:10:28.000000000 +0200 +++ new/lens-4.15.1/benchmarks/plated.hs 2016-10-10 05:56:36.000000000 +0200 @@ -22,7 +22,6 @@ import qualified Data.Generics.Uniplate.DataOnly as UniDataOnly #endif import Generics.Deriving hiding (universe) -import GHC.Generics.Lens as Generic data Expr = Val !Int | Var String @@ -67,7 +66,6 @@ main = defaultMain [ bench "universe" $ nf (map universe) testsExpr , bench "universeOf plate" $ nf (map (universeOf plate)) testsExpr - , bench "universeOf Generic.tinplate" $ nf (map (universeOf Generic.tinplate)) testsExpr , bench "universeOf Data.tinplate" $ nf (map (universeOf Data.tinplate)) testsExpr , bench "universeOf Data.template" $ nf (map (universeOf Data.template)) testsExpr , bench "universeOf Data.uniplate" $ nf (map (universeOf Data.uniplate)) testsExpr diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/lens-4.14/examples/lens-examples.cabal new/lens-4.15.1/examples/lens-examples.cabal --- old/lens-4.14/examples/lens-examples.cabal 2016-04-28 23:10:28.000000000 +0200 +++ new/lens-4.15.1/examples/lens-examples.cabal 2016-10-10 05:56:36.000000000 +0200 @@ -29,9 +29,9 @@ build-depends: base, - containers >= 0.4 && < 0.6, - gloss == 1.7.*, + containers >= 0.4 && < 0.6, + gloss >= 1.7 && < 1.11, lens, - mtl >= 2.0.1 && < 2.2, - random == 1.0.* + mtl >= 2.0.1 && < 2.3, + random >= 1.0 && < 1.2 main-is: Pong.hs diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/lens-4.14/lens.cabal new/lens-4.15.1/lens.cabal --- old/lens-4.14/lens.cabal 2016-04-28 23:10:28.000000000 +0200 +++ new/lens-4.15.1/lens.cabal 2016-10-10 05:56:36.000000000 +0200 @@ -1,6 +1,6 @@ name: lens category: Data, Lenses, Generics -version: 4.14 +version: 4.15.1 license: BSD3 cabal-version: >= 1.8 license-file: LICENSE @@ -211,6 +211,9 @@ vector >= 0.9 && < 0.12, void >= 0.5 && < 1 + if impl(ghc < 8.0) + build-depends: generic-deriving >= 1.10 && < 2 + exposed-modules: Control.Exception.Lens Control.Lens @@ -285,7 +288,6 @@ Data.Typeable.Lens Data.Vector.Lens Data.Vector.Generic.Lens - Generics.Deriving.Lens GHC.Generics.Lens System.Exit.Lens System.FilePath.Lens @@ -392,7 +394,7 @@ other-extensions: Trustworthy cpp-options: -DTRUSTWORTHY=1 - if !flag(test-doctests) || impl(ghc>=8) + if !flag(test-doctests) buildable: False else build-depends: diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/lens-4.14/src/Control/Lens/At.hs new/lens-4.15.1/src/Control/Lens/At.hs --- old/lens-4.14/src/Control/Lens/At.hs 2016-04-28 23:10:28.000000000 +0200 +++ new/lens-4.15.1/src/Control/Lens/At.hs 2016-10-10 05:56:36.000000000 +0200 @@ -21,6 +21,10 @@ #ifndef MIN_VERSION_base #define MIN_VERSION_base(x,y,z) 1 #endif + +#ifndef MIN_VERSION_containers +#define MIN_VERSION_containers(x,y,z) 1 +#endif ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.At @@ -454,17 +458,25 @@ {-# INLINE at #-} instance At (IntMap a) where +#if MIN_VERSION_containers(0,5,8) + at k f = IntMap.alterF f k +#else at k f m = f mv <&> \r -> case r of Nothing -> maybe m (const (IntMap.delete k m)) mv Just v' -> IntMap.insert k v' m where mv = IntMap.lookup k m +#endif {-# INLINE at #-} instance Ord k => At (Map k a) where +#if MIN_VERSION_containers(0,5,8) + at k f = Map.alterF f k +#else at k f m = f mv <&> \r -> case r of Nothing -> maybe m (const (Map.delete k m)) mv Just v' -> Map.insert k v' m where mv = Map.lookup k m +#endif {-# INLINE at #-} instance (Eq k, Hashable k) => At (HashMap k a) where diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/lens-4.14/src/Control/Lens/Fold.hs new/lens-4.15.1/src/Control/Lens/Fold.hs --- old/lens-4.14/src/Control/Lens/Fold.hs 2016-04-28 23:10:28.000000000 +0200 +++ new/lens-4.15.1/src/Control/Lens/Fold.hs 2016-10-10 05:56:36.000000000 +0200 @@ -4,15 +4,11 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} -#ifndef MIN_VERSION_profunctors -#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)) +#if __GLASGOW_HASKELL__ < 708 {-# LANGUAGE Trustworthy #-} #endif diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/lens-4.14/src/Control/Lens/Getter.hs new/lens-4.15.1/src/Control/Lens/Getter.hs --- old/lens-4.14/src/Control/Lens/Getter.hs 2016-04-28 23:10:28.000000000 +0200 +++ new/lens-4.15.1/src/Control/Lens/Getter.hs 2016-10-10 05:56:36.000000000 +0200 @@ -3,12 +3,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} - -#ifndef MIN_VERSION_profunctors -#define MIN_VERSION_profunctors(x,y,z) 1 -#endif - -#if __GLASGOW_HASKELL__ < 708 || !(MIN_VERSION_profunctors(4,4,0)) +#if __GLASGOW_HASKELL__ < 708 {-# LANGUAGE Trustworthy #-} #endif @@ -16,6 +11,13 @@ {-# LANGUAGE NoPolyKinds #-} {-# LANGUAGE NoDataKinds #-} #endif + +-- Disable the warnings generated by 'to', 'ito', 'like', 'ilike'. +-- These functions are intended to produce 'Getters'. Without this constraint +-- users would get warnings when annotating types at uses of these functions. +#if __GLASGOW_HASKELL__ >= 711 +{-# OPTIONS_GHC -fno-warn-redundant-constraints #-} +#endif ------------------------------------------------------------------------------- -- | -- Module : Control.Lens.Getter @@ -137,7 +139,7 @@ -- @ -- 'to' :: (s -> a) -> 'IndexPreservingGetter' s a -- @ -to :: (Profunctor p, Contravariant f) => (s -> a) -> Optic' p f s a +to :: (Profunctor p, Contravariant f, Functor f) => (s -> a) -> Optic' p f s a to k = dimap k (contramap k) {-# INLINE to #-} @@ -145,7 +147,7 @@ -- @ -- 'ito' :: (s -> (i, a)) -> 'IndexedGetter' i s a -- @ -ito :: (Indexable i p, Contravariant f) => (s -> (i, a)) -> Over' p f s a +ito :: (Indexable i p, Contravariant f, Functor f) => (s -> (i, a)) -> Over' p f s a ito k = dimap k (contramap (snd . k)) . uncurry . indexed {-# INLINE ito #-} @@ -164,7 +166,7 @@ -- @ -- 'like' :: a -> 'IndexPreservingGetter' s a -- @ -like :: (Profunctor p, Contravariant f) => a -> Optic' p f s a +like :: (Profunctor p, Contravariant f, Functor f) => a -> Optic' p f s a like a = to (const a) {-# INLINE like #-} @@ -172,7 +174,7 @@ -- @ -- 'ilike' :: i -> a -> 'IndexedGetter' i s a -- @ -ilike :: (Indexable i p, Contravariant f) => i -> a -> Over' p f s a +ilike :: (Indexable i p, Contravariant f, Functor f) => i -> a -> Over' p f s a ilike i a = ito (const (i, a)) {-# INLINE ilike #-} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/lens-4.14/src/Control/Lens/Indexed.hs new/lens-4.15.1/src/Control/Lens/Indexed.hs --- old/lens-4.14/src/Control/Lens/Indexed.hs 2016-04-28 23:10:28.000000000 +0200 +++ new/lens-4.15.1/src/Control/Lens/Indexed.hs 2016-10-10 05:56:36.000000000 +0200 @@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE Rank2Types #-} +{-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE DefaultSignatures #-} @@ -12,10 +13,6 @@ {-# LANGUAGE Trustworthy #-} -- vector, hashable #endif -#if __GLASGOW_HASKELL__ >= 711 -{-# OPTIONS_GHC -fno-warn-redundant-constraints #-} -#endif - #ifndef MIN_VERSION_base #define MIN_VERSION_base(x,y,z) 1 #endif @@ -110,20 +107,24 @@ import Data.Functor.Contravariant import Data.Functor.Product import Data.Functor.Reverse -import Data.Hashable +import Data.Functor.Sum import Data.HashMap.Lazy as HashMap import Data.IntMap as IntMap import Data.Ix (Ix) import Data.List.NonEmpty as NonEmpty import Data.Map as Map -import Data.Monoid hiding (Product) +import Data.Monoid hiding (Sum, Product) import Data.Profunctor.Unsafe +import Data.Proxy import Data.Reflection import Data.Sequence hiding ((:<), index) +import Data.Tagged import Data.Tree import Data.Tuple (swap) import Data.Vector (Vector) +import Data.Void import qualified Data.Vector as V +import GHC.Generics import Prelude #if !(MIN_VERSION_base(4,8,0)) @@ -630,6 +631,13 @@ itraversed = traversed {-# INLINE itraversed #-} +-- | Same instance as for @[]@. +instance FunctorWithIndex Int ZipList +instance FoldableWithIndex Int ZipList +instance TraversableWithIndex Int ZipList where + itraversed = traversed + {-# INLINE itraversed #-} + instance FunctorWithIndex Int NonEmpty instance FoldableWithIndex Int NonEmpty instance TraversableWithIndex Int NonEmpty where @@ -650,14 +658,20 @@ instance FunctorWithIndex Int Seq where imap = mapWithIndex instance FoldableWithIndex Int Seq where +#if MIN_VERSION_containers(0,5,8) + ifoldMap = foldMapWithIndex +#else ifoldMap f = Data.Foldable.fold . mapWithIndex f +#endif ifoldr = foldrWithIndex ifoldl f = foldlWithIndex (flip f) {-# INLINE ifoldl #-} instance TraversableWithIndex Int Seq where --- The next version of containers will probably offer traverseWithIndex; --- when that comes out, it should be used for this. +#if MIN_VERSION_containers(0,5,8) + itraverse = traverseWithIndex +#else itraverse f = sequenceA . mapWithIndex f +#endif instance FunctorWithIndex Int Vector where imap = V.imap @@ -709,9 +723,9 @@ "itraversed -> ifoldrMap" itraversed = ifoldring Map.foldrWithKey :: IndexedGetting k (Endo r) (Map k a) a; #-} -instance (Eq k, Hashable k) => FunctorWithIndex k (HashMap k) -instance (Eq k, Hashable k) => FoldableWithIndex k (HashMap k) -instance (Eq k, Hashable k) => TraversableWithIndex k (HashMap k) where +instance FunctorWithIndex k (HashMap k) +instance FoldableWithIndex k (HashMap k) +instance TraversableWithIndex k (HashMap k) where itraverse = HashMap.traverseWithKey {-# INLINE [0] itraverse #-} @@ -819,6 +833,21 @@ itraverse f (Compose fg) = Compose <$> itraverse (\k -> itraverse (f . (,) k)) fg {-# INLINE itraverse #-} +instance (FunctorWithIndex i f, FunctorWithIndex j g) => FunctorWithIndex (Either i j) (Sum f g) where + imap q (InL fa) = InL (imap (q . Left) fa) + imap q (InR ga) = InR (imap (q . Right) ga) + {-# INLINE imap #-} + +instance (FoldableWithIndex i f, FoldableWithIndex j g) => FoldableWithIndex (Either i j) (Sum f g) where + ifoldMap q (InL fa) = ifoldMap (q . Left) fa + ifoldMap q (InR ga) = ifoldMap (q . Right) ga + {-# INLINE ifoldMap #-} + +instance (TraversableWithIndex i f, TraversableWithIndex j g) => TraversableWithIndex (Either i j) (Sum f g) where + itraverse q (InL fa) = InL <$> itraverse (q . Left) fa + itraverse q (InR ga) = InR <$> itraverse (q . Right) ga + {-# INLINE itraverse #-} + instance FunctorWithIndex i m => FunctorWithIndex i (IdentityT m) where imap f (IdentityT m) = IdentityT $ imap f m {-# INLINE imap #-} @@ -863,6 +892,127 @@ itraverse f (Node a as) = Node <$> f [] a <*> itraverse (\i -> itraverse (f . (:) i)) as {-# INLINE itraverse #-} +instance FunctorWithIndex Void Proxy where + imap _ Proxy = Proxy + {-# INLINE imap #-} + +instance FoldableWithIndex Void Proxy where + ifoldMap _ _ = mempty + {-# INLINE ifoldMap #-} + +instance TraversableWithIndex Void Proxy where + itraverse _ _ = pure Proxy + {-# INLINE itraverse #-} + +instance FunctorWithIndex () (Tagged a) where + imap f (Tagged a) = Tagged (f () a) + {-# INLINE imap #-} + +instance FoldableWithIndex () (Tagged a) where + ifoldMap f (Tagged a) = f () a + {-# INLINE ifoldMap #-} + +instance TraversableWithIndex () (Tagged a) where + itraverse f (Tagged a) = Tagged <$> f () a + {-# INLINE itraverse #-} + +instance FunctorWithIndex Void V1 where + imap _ v = v `seq` undefined + {-# INLINE imap #-} + +instance FoldableWithIndex Void V1 where + ifoldMap _ v = v `seq` undefined + +instance TraversableWithIndex Void V1 where + itraverse _ v = v `seq` undefined + +instance FunctorWithIndex Void U1 where + imap _ U1 = U1 + {-# INLINE imap #-} + +instance FoldableWithIndex Void U1 where + ifoldMap _ _ = mempty + {-# INLINE ifoldMap #-} + +instance TraversableWithIndex Void U1 where + itraverse _ U1 = pure U1 + {-# INLINE itraverse #-} + +instance FunctorWithIndex () Par1 where + imap f = fmap (f ()) + {-# INLINE imap #-} + +instance FoldableWithIndex () Par1 where + ifoldMap f (Par1 a) = f () a + {-# INLINE ifoldMap #-} + +instance TraversableWithIndex () Par1 where + itraverse f (Par1 a) = Par1 <$> f () a + {-# INLINE itraverse #-} + +instance (FunctorWithIndex i f, FunctorWithIndex j g) => FunctorWithIndex (i, j) (f :.: g) where + imap q (Comp1 fga) = Comp1 (imap (\k -> imap (q . (,) k)) fga) + {-# INLINE imap #-} + +instance (FoldableWithIndex i f, FoldableWithIndex j g) => FoldableWithIndex (i, j) (f :.: g) where + ifoldMap q (Comp1 fga) = ifoldMap (\k -> ifoldMap (q . (,) k)) fga + {-# INLINE ifoldMap #-} + +instance (TraversableWithIndex i f, TraversableWithIndex j g) => TraversableWithIndex (i, j) (f :.: g) where + itraverse q (Comp1 fga) = Comp1 <$> itraverse (\k -> itraverse (q . (,) k)) fga + {-# INLINE itraverse #-} + +instance (FunctorWithIndex i f, FunctorWithIndex j g) => FunctorWithIndex (Either i j) (f :*: g) where + imap q (fa :*: ga) = imap (q . Left) fa :*: imap (q . Right) ga + {-# INLINE imap #-} + +instance (FoldableWithIndex i f, FoldableWithIndex j g) => FoldableWithIndex (Either i j) (f :*: g) where + ifoldMap q (fa :*: ga) = ifoldMap (q . Left) fa `mappend` ifoldMap (q . Right) ga + {-# INLINE ifoldMap #-} + +instance (TraversableWithIndex i f, TraversableWithIndex j g) => TraversableWithIndex (Either i j) (f :*: g) where + itraverse q (fa :*: ga) = (:*:) <$> itraverse (q . Left) fa <*> itraverse (q . Right) ga + {-# INLINE itraverse #-} + +instance (FunctorWithIndex i f, FunctorWithIndex j g) => FunctorWithIndex (Either i j) (f :+: g) where + imap q (L1 fa) = L1 (imap (q . Left) fa) + imap q (R1 ga) = R1 (imap (q . Right) ga) + {-# INLINE imap #-} + +instance (FoldableWithIndex i f, FoldableWithIndex j g) => FoldableWithIndex (Either i j) (f :+: g) where + ifoldMap q (L1 fa) = ifoldMap (q . Left) fa + ifoldMap q (R1 ga) = ifoldMap (q . Right) ga + {-# INLINE ifoldMap #-} + +instance (TraversableWithIndex i f, TraversableWithIndex j g) => TraversableWithIndex (Either i j) (f :+: g) where + itraverse q (L1 fa) = L1 <$> itraverse (q . Left) fa + itraverse q (R1 ga) = R1 <$> itraverse (q . Right) ga + {-# INLINE itraverse #-} + +instance FunctorWithIndex i f => FunctorWithIndex i (Rec1 f) where + imap q (Rec1 f) = Rec1 (imap q f) + {-# INLINE imap #-} + +instance FoldableWithIndex i f => FoldableWithIndex i (Rec1 f) where + ifoldMap q (Rec1 f) = ifoldMap q f + {-# INLINE ifoldMap #-} + +instance TraversableWithIndex i f => TraversableWithIndex i (Rec1 f) where + itraverse q (Rec1 f) = Rec1 <$> itraverse q f + {-# INLINE itraverse #-} + +instance FunctorWithIndex Void (K1 i c) where + imap _ (K1 c) = K1 c + {-# INLINE imap #-} + +instance FoldableWithIndex Void (K1 i c) where + ifoldMap _ _ = mempty + {-# INLINE ifoldMap #-} + +instance TraversableWithIndex Void (K1 i c) where + itraverse _ (K1 a) = pure (K1 a) + {-# INLINE itraverse #-} + ------------------------------------------------------------------------------- -- Misc. ------------------------------------------------------------------------------- diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/lens-4.14/src/Control/Lens/Internal/Coerce.hs new/lens-4.15.1/src/Control/Lens/Internal/Coerce.hs --- old/lens-4.14/src/Control/Lens/Internal/Coerce.hs 2016-04-28 23:10:28.000000000 +0200 +++ new/lens-4.15.1/src/Control/Lens/Internal/Coerce.hs 2016-10-10 05:56:36.000000000 +0200 @@ -1,10 +1,6 @@ {-# LANGUAGE CPP #-} -#ifndef MIN_VERSION_profunctors -#define MIN_VERSION_profunctors(x,y,z) 0 -#endif - -#if (MIN_VERSION_profunctors(4,4,0)) && __GLASGOW_HASKELL__ >= 708 +#if __GLASGOW_HASKELL__ >= 708 #define USE_COERCE {-# LANGUAGE Trustworthy #-} {-# LANGUAGE RankNTypes #-} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/lens-4.14/src/Control/Lens/Internal/Context.hs new/lens-4.15.1/src/Control/Lens/Internal/Context.hs --- old/lens-4.14/src/Control/Lens/Internal/Context.hs 2016-04-28 23:10:28.000000000 +0200 +++ new/lens-4.15.1/src/Control/Lens/Internal/Context.hs 2016-10-10 05:56:36.000000000 +0200 @@ -9,9 +9,7 @@ #if __GLASGOW_HASKELL__ >= 707 {-# LANGUAGE RoleAnnotations #-} #endif -#if __GLASGOW_HASKELL__ >= 711 -{-# OPTIONS_GHC -fno-warn-redundant-constraints #-} -#endif + ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Internal.Context diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/lens-4.14/src/Control/Lens/Internal/FieldTH.hs new/lens-4.15.1/src/Control/Lens/Internal/FieldTH.hs --- old/lens-4.14/src/Control/Lens/Internal/FieldTH.hs 2016-04-28 23:10:28.000000000 +0200 +++ new/lens-4.15.1/src/Control/Lens/Internal/FieldTH.hs 2016-10-10 05:56:36.000000000 +0200 @@ -38,7 +38,6 @@ import Control.Monad import Language.Haskell.TH.Lens import Language.Haskell.TH -import Data.Foldable (toList) import Data.Maybe (isJust,maybeToList) import Data.List (nub, findIndices) import Data.Either (partitionEithers) @@ -592,16 +591,17 @@ -- | Template Haskell wants type variables declared in a forall, so -- we find all free type variables in a given type and declare them. quantifyType :: Cxt -> Type -> Type -quantifyType c t = ForallT vs c t - where - vs = map PlainTV (toList (setOf typeVars t)) +quantifyType = quantifyType' Set.empty -- | This function works like 'quantifyType' except that it takes -- a list of variables to exclude from quantification. quantifyType' :: Set Name -> Cxt -> Type -> Type quantifyType' exclude c t = ForallT vs c t where - vs = map PlainTV (toList (setOf typeVars t Set.\\ exclude)) + vs = map PlainTV + $ filter (`Set.notMember` exclude) + $ nub -- stable order + $ toListOf typeVars t ------------------------------------------------------------------------ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/lens-4.14/src/Control/Lens/Internal/Indexed.hs new/lens-4.15.1/src/Control/Lens/Internal/Indexed.hs --- old/lens-4.14/src/Control/Lens/Internal/Indexed.hs 2016-04-28 23:10:28.000000000 +0200 +++ new/lens-4.15.1/src/Control/Lens/Internal/Indexed.hs 2016-10-10 05:56:36.000000000 +0200 @@ -6,11 +6,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE MultiParamTypeClasses #-} -#ifndef MIN_VERSION_profunctors -#define MIN_VERSION_profunctors(x,y,z) 1 -#endif - -#if __GLASGOW_HASKELL__ < 708 || !(MIN_VERSION_profunctors(4,4,0)) +#if __GLASGOW_HASKELL__ < 708 {-# LANGUAGE Trustworthy #-} #endif diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/lens-4.14/src/Control/Lens/Internal/Instances.hs new/lens-4.15.1/src/Control/Lens/Internal/Instances.hs --- old/lens-4.14/src/Control/Lens/Internal/Instances.hs 2016-04-28 23:10:28.000000000 +0200 +++ new/lens-4.15.1/src/Control/Lens/Internal/Instances.hs 2016-10-10 05:56:36.000000000 +0200 @@ -1,9 +1,3 @@ -{-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} - -#ifndef MIN_VERSION_semigroupoids -#define MIN_VERSION_semigroupoids(x,y,z) 1 -#endif ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Internal.Instances diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/lens-4.14/src/Control/Lens/Internal/PrismTH.hs new/lens-4.15.1/src/Control/Lens/Internal/PrismTH.hs --- old/lens-4.14/src/Control/Lens/Internal/PrismTH.hs 2016-04-28 23:10:28.000000000 +0200 +++ new/lens-4.15.1/src/Control/Lens/Internal/PrismTH.hs 2016-10-10 05:56:36.000000000 +0200 @@ -24,6 +24,7 @@ ) where import Control.Applicative +import Control.Lens.Fold import Control.Lens.Getter import Control.Lens.Internal.TH import Control.Lens.Lens @@ -190,7 +191,9 @@ ReviewType -> reviewTypeName `conAppsT` [t,b] where - vs = map PlainTV (Set.toList (setOf typeVars cx)) + vs = map PlainTV + $ nub -- stable order + $ toListOf typeVars cx stabType :: Stab -> OpticType stabType (Stab _ o _ _ _ _) = o diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/lens-4.14/src/Control/Lens/Internal/Setter.hs new/lens-4.15.1/src/Control/Lens/Internal/Setter.hs --- old/lens-4.14/src/Control/Lens/Internal/Setter.hs 2016-04-28 23:10:28.000000000 +0200 +++ new/lens-4.15.1/src/Control/Lens/Internal/Setter.hs 2016-10-10 05:56:36.000000000 +0200 @@ -1,10 +1,6 @@ {-# LANGUAGE CPP #-} -#ifndef MIN_VERSION_profunctors -#define MIN_VERSION_profunctors(x,y,z) 1 -#endif - -#if __GLASGOW_HASKELL__ < 708 || !(MIN_VERSION_profunctors(4,4,0)) +#if __GLASGOW_HASKELL__ < 708 {-# LANGUAGE Trustworthy #-} #endif diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/lens-4.14/src/Control/Lens/Iso.hs new/lens-4.15.1/src/Control/Lens/Iso.hs --- old/lens-4.14/src/Control/Lens/Iso.hs 2016-04-28 23:10:28.000000000 +0200 +++ new/lens-4.15.1/src/Control/Lens/Iso.hs 2016-10-10 05:56:36.000000000 +0200 @@ -7,19 +7,13 @@ #if __GLASGOW_HASKELL__ >= 710 {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE Trustworthy #-} #endif #ifndef MIN_VERSION_bytestring #define MIN_VERSION_bytestring(x,y,z) 1 #endif -#ifndef MIN_VERSION_profunctors -#define MIN_VERSION_profunctors(x,y,z) 1 -#endif - -#if __GLASGOW_HASKELL__ < 708 || !(MIN_VERSION_profunctors(4,4,0)) -{-# LANGUAGE Trustworthy #-} -#endif ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Iso @@ -87,7 +81,7 @@ , bimapping , firsting , seconding -#if __GLASGOW_HASKELL__ >= 710 +#if __GLASGOW_HASKELL__ >= 708 -- * Coercions , coerced #endif @@ -114,10 +108,6 @@ import Data.ByteString as StrictB hiding (reverse) import Data.ByteString.Lazy as LazyB hiding (reverse) -#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) @@ -126,6 +116,13 @@ import Data.Profunctor import Data.Profunctor.Unsafe +#if __GLASGOW_HASKELL__ >= 708 +import Data.Coerce (Coercible) +#if __GLASGOW_HASKELL__ < 710 +import Data.Type.Coercion +#endif +#endif + #if __GLASGOW_HASKELL__ >= 710 import qualified GHC.Exts as Exts #endif @@ -600,12 +597,17 @@ seconding p = withIso p $ \ sa bt -> iso (second sa) (second bt) {-# INLINE seconding #-} -#if __GLASGOW_HASKELL__ >= 710 +#if __GLASGOW_HASKELL__ >= 708 -- | Data types that are representationally equal are isomorphic. -- --- This is only available on GHC 7.10+ +-- This is only available on GHC 7.8+ -- -- @since 4.13 coerced :: forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b +#if __GLASGOW_HASKELL__ >= 710 coerced l = rmap (fmap coerce') l .# coerce +#else +coerced l = case sym Coercion :: Coercion a s of + Coercion -> rmap (fmap coerce') l .# coerce +#endif #endif diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/lens-4.14/src/Control/Lens/Lens.hs new/lens-4.15.1/src/Control/Lens/Lens.hs --- old/lens-4.14/src/Control/Lens/Lens.hs 2016-04-28 23:10:28.000000000 +0200 +++ new/lens-4.15.1/src/Control/Lens/Lens.hs 2016-10-10 05:56:36.000000000 +0200 @@ -10,11 +10,7 @@ #define MIN_VERSION_mtl(x,y,z) 1 #endif -#ifndef MIN_VERSION_profunctors -#define MIN_VERSION_profunctors(x,y,z) 1 -#endif - -#if __GLASGOW_HASKELL__ < 708 || !(MIN_VERSION_profunctors(4,4,0)) +#if __GLASGOW_HASKELL__ < 708 {-# LANGUAGE Trustworthy #-} #endif ------------------------------------------------------------------------------- @@ -372,15 +368,15 @@ -- @ -- fab ?? a = fmap ($ a) fab -- @ --- +-- -- For the 'Functor' instance @f = ((->) r)@ you can reason about this function as if the definition was @('??') ≡ 'flip'@: --- +-- -- >>> (h ?? x) a -- h a x --- +-- -- >>> execState ?? [] $ modify (1:) -- [1] --- +-- -- >>> over _2 ?? ("hello","world") $ length -- ("hello",5) -- @@ -1212,6 +1208,9 @@ -- 'Control.Lens.Setter.Setter', but requires a full lens, or close -- enough. -- +-- >>> overA _1 ((+1) *** (+2)) ((1,2),6) +-- ((2,4),6) +-- -- @ -- overA :: Arrow ar => Lens s t a b -> ar a b -> ar s t -- @ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/lens-4.14/src/Control/Lens/Level.hs new/lens-4.15.1/src/Control/Lens/Level.hs --- old/lens-4.14/src/Control/Lens/Level.hs 2016-04-28 23:10:28.000000000 +0200 +++ new/lens-4.15.1/src/Control/Lens/Level.hs 2016-10-10 05:56:36.000000000 +0200 @@ -2,11 +2,7 @@ {-# LANGUAGE Rank2Types #-} {-# LANGUAGE FlexibleContexts #-} -#ifndef MIN_VERSION_profunctors -#define MIN_VERSION_profunctors(x,y,z) 1 -#endif - -#if __GLASGOW_HASKELL__ < 708 || !(MIN_VERSION_profunctors(4,4,0)) +#if __GLASGOW_HASKELL__ < 708 {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/lens-4.14/src/Control/Lens/Review.hs new/lens-4.15.1/src/Control/Lens/Review.hs --- old/lens-4.14/src/Control/Lens/Review.hs 2016-04-28 23:10:28.000000000 +0200 +++ new/lens-4.15.1/src/Control/Lens/Review.hs 2016-10-10 05:56:36.000000000 +0200 @@ -1,11 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} -#ifndef MIN_VERSION_profunctors -#define MIN_VERSION_profunctors(x,y,z) 1 -#endif - -#if __GLASGOW_HASKELL__ < 708 || !(MIN_VERSION_profunctors(4,4,0)) +#if __GLASGOW_HASKELL__ < 708 {-# LANGUAGE Trustworthy #-} #endif ------------------------------------------------------------------------------- @@ -108,7 +104,7 @@ -- 're' :: 'Prism' s t a b -> 'Getter' b t -- 're' :: 'Iso' s t a b -> 'Getter' b t -- @ -re :: Contravariant f => AReview t b -> LensLike' f b t +re :: AReview t b -> Getter b t re p = to (runIdentity #. unTagged #. p .# Tagged .# Identity) {-# INLINE re #-} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/lens-4.14/src/Control/Lens/Setter.hs new/lens-4.15.1/src/Control/Lens/Setter.hs --- old/lens-4.14/src/Control/Lens/Setter.hs 2016-04-28 23:10:28.000000000 +0200 +++ new/lens-4.15.1/src/Control/Lens/Setter.hs 2016-10-10 05:56:36.000000000 +0200 @@ -4,11 +4,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} -#ifndef MIN_VERSION_profunctors -#define MIN_VERSION_profunctors(x,y,z) 1 -#endif - -#if __GLASGOW_HASKELL__ < 708 || !(MIN_VERSION_profunctors(4,4,0)) +#if __GLASGOW_HASKELL__ < 708 {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/lens-4.14/src/Control/Lens/TH.hs new/lens-4.15.1/src/Control/Lens/TH.hs --- old/lens-4.14/src/Control/Lens/TH.hs 2016-04-28 23:10:28.000000000 +0200 +++ new/lens-4.15.1/src/Control/Lens/TH.hs 2016-10-10 05:56:36.000000000 +0200 @@ -99,10 +99,12 @@ import Data.Char (toLower, isUpper) import Data.Foldable hiding (concat, any) import Data.List as List -import Data.Map as Map hiding (toList,map,filter) +import qualified Data.Map as Map +import Data.Map (Map) import Data.Maybe (maybeToList) import Data.Monoid -import Data.Set as Set hiding (toList,map,filter) +import qualified Data.Set as Set +import Data.Set (Set) import Data.Set.Lens import Data.Traversable hiding (mapM) import Language.Haskell.TH diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/lens-4.14/src/Control/Lens/Traversal.hs new/lens-4.15.1/src/Control/Lens/Traversal.hs --- old/lens-4.14/src/Control/Lens/Traversal.hs 2016-04-28 23:10:28.000000000 +0200 +++ new/lens-4.15.1/src/Control/Lens/Traversal.hs 2016-10-10 05:56:36.000000000 +0200 @@ -152,7 +152,8 @@ import Data.Functor.Yoneda import Data.Int import Data.IntMap as IntMap -import Data.Map as Map +import qualified Data.Map as Map +import Data.Map (Map) import Data.Sequence (Seq, mapWithIndex) import Data.Vector as Vector (Vector, imap) import Data.Monoid @@ -172,7 +173,7 @@ -- >>> :set -XNoOverloadedStrings -- >>> import Control.Lens -- >>> import Control.DeepSeq (NFData (..), force) --- >>> import Control.Exception (evaluate) +-- >>> import Control.Exception (evaluate,try,ErrorCall(..)) -- >>> import Data.Maybe (fromMaybe) -- >>> import Debug.SimpleReflect.Vars -- >>> import Data.Void @@ -636,8 +637,7 @@ -- >>> [1,2,3] ^. singular _head -- 1 -- --- >>> [] ^. singular _head --- *** Exception: singular: empty traversal +-- >>> Left (ErrorCall "singular: empty traversal") <- try (evaluate ([] ^. singular _head)) :: IO (Either ErrorCall ()) -- -- >>> Left 4 ^. singular _Left -- 4 @@ -672,8 +672,7 @@ -- The resulting 'Lens' or 'Getter' will be partial if the 'Traversal' targets nothing -- or more than one element. -- --- >>> [] & unsafeSingular traverse .~ 0 --- *** Exception: unsafeSingular: empty traversal +-- >>> Left (ErrorCall "unsafeSingular: empty traversal") <- try (evaluate ([] & unsafeSingular traverse .~ 0)) :: IO (Either ErrorCall [Integer]) -- -- @ -- 'unsafeSingular' :: 'Traversal' s t a b -> 'Lens' s t a b diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/lens-4.14/src/Control/Lens/Type.hs new/lens-4.15.1/src/Control/Lens/Type.hs --- old/lens-4.14/src/Control/Lens/Type.hs 2016-04-28 23:10:28.000000000 +0200 +++ new/lens-4.15.1/src/Control/Lens/Type.hs 2016-10-10 05:56:36.000000000 +0200 @@ -331,6 +331,14 @@ -- | Isomorphism families can be composed with another 'Lens' using ('.') and 'id'. -- +-- Since every 'Iso' is both a valid 'Lens' and a valid 'Prism', the laws for those types +-- imply the following laws for an 'Iso' 'f': +-- +-- @ +-- f '.' 'Control.Lens.Iso.from' f ≡ 'id' +-- 'Control.Lens.Iso.from' f '.' f ≡ 'id' +-- @ +-- -- Note: Composition with an 'Iso' is index- and measure- preserving. type Iso s t a b = forall p f. (Profunctor p, Functor f) => p a (f b) -> p s (f t) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/lens-4.14/src/Control/Lens/Wrapped.hs new/lens-4.15.1/src/Control/Lens/Wrapped.hs --- old/lens-4.14/src/Control/Lens/Wrapped.hs 2016-04-28 23:10:28.000000000 +0200 +++ new/lens-4.15.1/src/Control/Lens/Wrapped.hs 2016-10-10 05:56:36.000000000 +0200 @@ -90,6 +90,7 @@ #endif import Control.Monad.Trans.Cont import Control.Monad.Trans.Error +import Control.Monad.Trans.Except import Control.Monad.Trans.Identity import Control.Monad.Trans.List import Control.Monad.Trans.Maybe @@ -315,6 +316,12 @@ _Wrapped' = iso runErrorT ErrorT {-# INLINE _Wrapped' #-} +instance (t ~ ExceptT e' m' a') => Rewrapped (ExceptT e m a) t +instance Wrapped (ExceptT e m a) where + type Unwrapped (ExceptT e m a) = m (Either e a) + _Wrapped' = iso runExceptT ExceptT + {-# INLINE _Wrapped' #-} + instance (t ~ Identity b) => Rewrapped (Identity a) t instance Wrapped (Identity a) where type Unwrapped (Identity a) = a @@ -710,9 +717,6 @@ -- >>> ala Any foldMap [True,False] -- True -- --- >>> ala Sum foldMap [1,2,3,4] --- 10 --- -- >>> ala Product foldMap [1,2,3,4] -- 24 -- diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/lens-4.14/src/Control/Lens/Zoom.hs new/lens-4.15.1/src/Control/Lens/Zoom.hs --- old/lens-4.14/src/Control/Lens/Zoom.hs 2016-04-28 23:10:28.000000000 +0200 +++ new/lens-4.15.1/src/Control/Lens/Zoom.hs 2016-10-10 05:56:36.000000000 +0200 @@ -10,11 +10,7 @@ #define MIN_VERSION_mtl(x,y,z) 1 #endif -#ifndef MIN_VERSION_profunctors -#define MIN_VERSION_profunctors(x,y,z) 1 -#endif - -#if __GLASGOW_HASKELL__ < 708 || !(MIN_VERSION_profunctors(4,4,0)) +#if __GLASGOW_HASKELL__ < 708 {-# LANGUAGE Trustworthy #-} #endif diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/lens-4.14/src/Data/Map/Lens.hs new/lens-4.15.1/src/Data/Map/Lens.hs --- old/lens-4.14/src/Data/Map/Lens.hs 2016-04-28 23:10:28.000000000 +0200 +++ new/lens-4.15.1/src/Data/Map/Lens.hs 2016-10-10 05:56:36.000000000 +0200 @@ -60,9 +60,38 @@ -- Just "Uranus" -- ----------------------------------------------------------------------------- -module Data.Map.Lens () where +module Data.Map.Lens + ( toMapOf + ) where + +import Control.Lens.Getter ( IndexedGetting, iviews ) +import Control.Lens.Type +import qualified Data.Map as Map + -- $setup -- >>> import Control.Lens -- >>> import Data.Monoid --- >>> import qualified Data.Map as Map -- >>> :set -XNoOverloadedStrings + +-- | Construct a map from a 'IndexedGetter', 'Control.Lens.Fold.IndexedFold', 'Control.Lens.Traversal.IndexedTraversal' or 'Control.Lens.Lens.IndexedLens' +-- +-- The construction is left-biased (see 'Data.Map.Lazy.union'), i.e. the first +-- occurences of keys in the fold or traversal order are preferred. +-- +-- >>> toMapOf folded ["hello", "world"] +-- fromList [(0,"hello"),(1,"world")] +-- +-- >>> toMapOf (folded <.> folded) ["foo", "bar"] +-- fromList [((0,0),'f'),((0,1),'o'),((0,2),'o'),((1,0),'b'),((1,1),'a'),((1,2),'r')] +-- +-- >>> toMapOf ifolded $ Map.fromList [('a', "hello"), ('b', "world")] +-- fromList [('a',"hello"),('b',"world")] +-- +-- @ +-- 'toMapOf' :: 'IndexedGetter' i s a -> s -> 'Map.Map' i a +-- 'toMapOf' :: 'Ord' i => 'IndexedFold' i s a -> s -> 'Map.Map' i a +-- 'toMapOf' :: 'IndexedLens'' i s a -> s -> 'Map.Map' i a +-- 'toMapOf' :: 'Ord' i => 'IndexedTraversal'' i s a -> s -> 'Map.Map' i a +-- @ +toMapOf :: IndexedGetting i (Map.Map i a) s a -> s -> Map.Map i a +toMapOf l = iviews l Map.singleton diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/lens-4.14/src/GHC/Generics/Lens.hs new/lens-4.15.1/src/GHC/Generics/Lens.hs --- old/lens-4.14/src/GHC/Generics/Lens.hs 2016-04-28 23:10:28.000000000 +0200 +++ new/lens-4.15.1/src/GHC/Generics/Lens.hs 2016-10-10 05:56:36.000000000 +0200 @@ -1,5 +1,6 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} +{-# LANGUAGE MagicHash #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleContexts #-} @@ -29,7 +30,9 @@ -- package. ---------------------------------------------------------------------------- module GHC.Generics.Lens - ( module Generics.Deriving.Lens + ( + generic + , generic1 , _V1 , _U1 , _Par1 @@ -38,11 +41,39 @@ , _M1 , _L1 , _R1 + , _UAddr + , _UChar + , _UDouble + , _UFloat + , _UInt + , _UWord ) where -import Control.Lens -import Generics.Deriving.Lens -import GHC.Generics +import Control.Lens +import GHC.Exts (Char(..), Double(..), Float(..), + Int(..), Ptr(..), Word(..)) +import qualified GHC.Generics as Generic +import GHC.Generics hiding (from, to) + +#if !(MIN_VERSION_base(4,9,0)) +import Generics.Deriving.Base hiding (from, to) +#endif + +-- $setup +-- >>> :set -XNoOverloadedStrings + +-- | Convert from the data type to its representation (or back) +-- +-- >>> "hello"^.generic.from generic :: String +-- "hello" +generic :: Generic a => Iso' a (Rep a b) +generic = iso Generic.from Generic.to +{-# INLINE generic #-} + +-- | Convert from the data type to its representation (or back) +generic1 :: Generic1 f => Iso' (f a) (Rep1 f a) +generic1 = iso from1 to1 +{-# INLINE generic1 #-} _V1 :: Over p f (V1 s) (V1 t) a b _V1 _ = absurd where @@ -86,3 +117,45 @@ reviewer (R1 l) = Right l reviewer x = Left x {-# INLINE _R1 #-} + +_UAddr :: Iso (UAddr p) (UAddr q) (Ptr c) (Ptr d) +_UAddr = iso remitter reviewer + where + remitter (UAddr a) = Ptr a + reviewer (Ptr a) = UAddr a +{-# INLINE _UAddr #-} + +_UChar :: Iso (UChar p) (UChar q) Char Char +_UChar = iso remitter reviewer + where + remitter (UChar c) = C# c + reviewer (C# c) = UChar c +{-# INLINE _UChar #-} + +_UDouble :: Iso (UDouble p) (UDouble q) Double Double +_UDouble = iso remitter reviewer + where + remitter (UDouble d) = D# d + reviewer (D# d) = UDouble d +{-# INLINE _UDouble #-} + +_UFloat :: Iso (UFloat p) (UFloat q) Float Float +_UFloat = iso remitter reviewer + where + remitter (UFloat f) = F# f + reviewer (F# f) = UFloat f +{-# INLINE _UFloat #-} + +_UInt :: Iso (UInt p) (UInt q) Int Int +_UInt = iso remitter reviewer + where + remitter (UInt i) = I# i + reviewer (I# i) = UInt i +{-# INLINE _UInt #-} + +_UWord :: Iso (UWord p) (UWord q) Word Word +_UWord = iso remitter reviewer + where + remitter (UWord w) = W# w + reviewer (W# w) = UWord w +{-# INLINE _UWord #-} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/lens-4.14/src/Generics/Deriving/Lens.hs new/lens-4.15.1/src/Generics/Deriving/Lens.hs --- old/lens-4.14/src/Generics/Deriving/Lens.hs 2016-04-28 23:10:28.000000000 +0200 +++ new/lens-4.15.1/src/Generics/Deriving/Lens.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,118 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE Rank2Types #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE UndecidableInstances #-} - -#if __GLASGOW_HASKELL__ >= 711 -{-# OPTIONS_GHC -fno-warn-redundant-constraints #-} -#endif - -#ifndef MIN_VERSION_base -#define MIN_VERSION_base(x,y,z) 1 -#endif - ------------------------------------------------------------------------------ --- | --- Module : Generics.Deriving.Lens --- Copyright : (C) 2012-16 Edward Kmett --- License : BSD-style (see the file LICENSE) --- Maintainer : Edward Kmett <[email protected]> --- Stability : experimental --- Portability : GHC --- --- Note: @Generics.Deriving@ exports a number of names that collide with @Control.Lens@. --- --- You can use hiding to mitigate this to an extent, and the following import --- represents a fair compromise for user code: --- --- > import Generics.Deriving hiding (from, to) --- --- You can use 'generic' to replace 'Generics.Deriving.from' and --- 'Generics.Deriving.to' from @Generics.Deriving@. ----------------------------------------------------------------------------- -module Generics.Deriving.Lens - ( - -- * Isomorphisms for @GHC.Generics@ - generic - , generic1 - -- * Generic Traversal - , tinplate - , GTraversal - ) where - -import Control.Lens -import Data.Maybe (fromJust) -import Data.Typeable -import qualified GHC.Generics as Generic -import GHC.Generics hiding (from, to) - -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -#endif - --- $setup --- >>> :set -XNoOverloadedStrings - --- | Convert from the data type to its representation (or back) --- --- >>> "hello"^.generic.from generic :: String --- "hello" -generic :: Generic a => Iso' a (Generic.Rep a b) -generic = iso Generic.from Generic.to -{-# INLINE generic #-} - --- | Convert from the data type to its representation (or back) -generic1 :: Generic1 f => Iso' (f a) (Rep1 f a) -generic1 = iso from1 to1 -{-# INLINE generic1 #-} - --- | A 'GHC.Generics.Generic' 'Traversal' that visits every occurrence --- of something 'Typeable' anywhere in a container. --- --- >>> allOf tinplate (=="Hello") (1::Int,2::Double,(),"Hello",["Hello"]) --- True --- --- >>> mapMOf_ tinplate putStrLn ("hello",[(2 :: Int, "world!")]) --- hello --- world! -tinplate :: (Generic a, GTraversal (Generic.Rep a), Typeable b) => Traversal' a b -tinplate = generic . tinplated Nothing -{-# INLINE tinplate #-} - -maybeArg1Of :: Maybe c -> (c -> d) -> Maybe c -maybeArg1Of = const -{-# INLINE maybeArg1Of #-} - --- | Used to traverse 'Generic' data by 'uniplate'. -class GTraversal f where - tinplated :: Typeable b => Maybe TypeRep -> Traversal' (f a) b - -instance (Generic a, GTraversal (Generic.Rep a), Typeable a) => GTraversal (K1 i a) where - tinplated prev f (K1 a) = case cast a `maybeArg1Of` f of - Just b -> K1 . fromJust . cast <$> f b - Nothing -> case prev of - Just rep | rep == typeOf a -> pure (K1 a) - _ -> K1 <$> fmap generic (tinplated (Just (typeOf a))) f a - {-# INLINE tinplated #-} - -instance GTraversal U1 where - tinplated _ _ U1 = pure U1 - {-# INLINE tinplated #-} - -instance GTraversal V1 where - tinplated _ _ v = v `seq` undefined - {-# INLINE tinplated #-} - -instance (GTraversal f, GTraversal g) => GTraversal (f :*: g) where - tinplated _ f (x :*: y) = (:*:) <$> tinplated Nothing f x <*> tinplated Nothing f y - {-# INLINE tinplated #-} - -instance (GTraversal f, GTraversal g) => GTraversal (f :+: g) where - tinplated _ f (L1 x) = L1 <$> tinplated Nothing f x - tinplated _ f (R1 x) = R1 <$> tinplated Nothing f x - {-# INLINE tinplated #-} - -instance GTraversal a => GTraversal (M1 i c a) where - tinplated prev f (M1 x) = M1 <$> tinplated prev f x - {-# INLINE tinplated #-} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/lens-4.14/src/System/FilePath/Lens.hs new/lens-4.15.1/src/System/FilePath/Lens.hs --- old/lens-4.14/src/System/FilePath/Lens.hs 2016-04-28 23:10:28.000000000 +0200 +++ new/lens-4.15.1/src/System/FilePath/Lens.hs 2016-10-10 05:56:36.000000000 +0200 @@ -39,13 +39,30 @@ -- $setup -- >>> :set -XNoOverloadedStrings +{- NB: Be very careful if you are planning to modify the doctest output in +this module! Path separators are OS-dependent (\\ with Windows, / with Posix), +so we take great care to avoid using separators in doctest output so that they +will be valid on all operating systems. + +If you find yourself wanting to test a function that uses path separators in +the output, it would be wise to: + +1. Compare the tested expression and the expected results explicitly using (==). +2. Always use the </> function (and derived combinators) to construct path + separators instead of typing them manually. That is, don't type out + "foo/bar", but rather "foo" </> "bar". + +This way we can avoid leaking path separators into the output. See the doctest +example for (</>~) for an example of how to do this. +-} + infixr 4 </>~, <</>~, <<</>~, <.>~, <<.>~, <<<.>~ infix 4 </>=, <</>=, <<</>=, <.>=, <<.>=, <<<.>= -- | Modify the path by adding another path. -- --- >>> both </>~ "bin" $ ("hello","world") --- ("hello/bin","world/bin") +-- >>> (both </>~ "bin" $ ("hello","world")) == ("hello" </> "bin", "world" </> "bin") +-- True -- -- @ -- ('</>~') :: 'Setter' s a 'FilePath' 'FilePath' -> 'FilePath' -> s -> a @@ -60,8 +77,8 @@ -- | Modify the target(s) of a 'Lens'', 'Iso'', 'Setter'' or 'Traversal'' by adding a path. -- --- >>> execState (both </>= "bin") ("hello","world") --- ("hello/bin","world/bin") +-- >>> execState (both </>= "bin") ("hello","world") == ("hello" </> "bin", "world" </> "bin") +-- True -- -- @ -- ('</>=') :: 'MonadState' s m => 'Setter'' s 'FilePath' -> 'FilePath' -> m () @@ -172,8 +189,8 @@ -- and filename component and the generated basenames are not null and contain no directory -- separators. -- --- >>> basename .~ "filename" $ "path/name.png" --- "path/filename.png" +-- >>> (basename .~ "filename" $ "path" </> "name.png") == "path" </> "filename.png" +-- True basename :: Lens' FilePath FilePath basename f p = (<.> takeExtension p) . (takeDirectory p </>) <$> f (takeBaseName p) {-# INLINE basename #-} @@ -184,8 +201,8 @@ -- Note: this is /not/ a legal 'Lens' unless the outer 'FilePath' already has a directory component, -- and generated directories are not null. -- --- >>> "long/path/name.txt" ^. directory --- "long/path" +-- >>> (("long" </> "path" </> "name.txt") ^. directory) == "long" </> "path" +-- True directory :: Lens' FilePath FilePath directory f p = (</> takeFileName p) <$> f (takeDirectory p) {-# INLINE directory #-} @@ -197,8 +214,8 @@ -- extension 'FilePath' components are either null or start with 'System.FilePath.extSeparator' -- and do not contain any internal 'System.FilePath.extSeparator's. -- --- >>> extension .~ ".png" $ "path/name.txt" --- "path/name.png" +-- >>> (extension .~ ".png" $ "path" </> "name.txt") == "path" </> "name.png" +-- True extension :: Lens' FilePath FilePath extension f p = (n <.>) <$> f e where @@ -212,8 +229,8 @@ -- filename 'FilePath' components are not null and do not contain any -- elements of 'System.FilePath.pathSeparators's. -- --- >>> filename .~ "name.txt" $ "path/name.png" --- "path/name.txt" +-- >>> (filename .~ "name.txt" $ "path" </> "name.png") == "path" </> "name.txt" +-- True filename :: Lens' FilePath FilePath filename f p = (takeDirectory p </>) <$> f (takeFileName p) {-# INLINE filename #-} ++++++ lens.cabal ++++++ ++++ 1017 lines (skipped) ++++ between /work/SRC/openSUSE:Factory/ghc-lens/lens.cabal ++++ and /work/SRC/openSUSE:Factory/.ghc-lens.new/lens.cabal
