packages feed

lens 4.14 → 4.15

raw patch · 30 files changed

+390/−256 lines, 30 filesdep ~base-orphansdep ~containersdep ~generic-deriving

Dependency ranges changed: base-orphans, containers, generic-deriving

Files

.gitignore view
@@ -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/
CHANGELOG.markdown view
@@ -1,3 +1,14 @@+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 +288,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.
benchmarks/plated.hs view
@@ -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
examples/lens-examples.cabal view
@@ -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
lens.cabal view
@@ -1,6 +1,6 @@ name:          lens category:      Data, Lenses, Generics-version:       4.14+version:       4.15 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:
src/Control/Lens/At.hs view
@@ -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
src/Control/Lens/Fold.hs view
@@ -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
src/Control/Lens/Getter.hs view
@@ -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 #-}
src/Control/Lens/Indexed.hs view
@@ -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 #-}@@ -861,6 +890,127 @@  instance TraversableWithIndex [Int] Tree where   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 #-}  -------------------------------------------------------------------------------
src/Control/Lens/Internal/Coerce.hs view
@@ -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 #-}
src/Control/Lens/Internal/Context.hs view
@@ -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
src/Control/Lens/Internal/FieldTH.hs view
@@ -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   ------------------------------------------------------------------------
src/Control/Lens/Internal/Indexed.hs view
@@ -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
src/Control/Lens/Internal/Instances.hs view
@@ -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
src/Control/Lens/Internal/PrismTH.hs view
@@ -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
src/Control/Lens/Internal/Setter.hs view
@@ -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
src/Control/Lens/Iso.hs view
@@ -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
src/Control/Lens/Lens.hs view
@@ -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) --@@ -1211,6 +1207,9 @@ -- Unlike 'Control.Lens.Setter.over', 'overA' can't accept a simple -- '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
src/Control/Lens/Level.hs view
@@ -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 -----------------------------------------------------------------------------
src/Control/Lens/Review.hs view
@@ -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 #-}
src/Control/Lens/Setter.hs view
@@ -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 -----------------------------------------------------------------------------
src/Control/Lens/TH.hs view
@@ -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
src/Control/Lens/Traversal.hs view
@@ -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
src/Control/Lens/Type.hs view
@@ -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)
src/Control/Lens/Wrapped.hs view
@@ -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@@ -709,9 +716,6 @@ -- -- >>> ala Any foldMap [True,False] -- True------ >>> ala Sum foldMap [1,2,3,4]--- 10 -- -- >>> ala Product foldMap [1,2,3,4] -- 24
src/Control/Lens/Zoom.hs view
@@ -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
src/Data/Map/Lens.hs view
@@ -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
src/GHC/Generics/Lens.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleContexts #-}@@ -29,8 +30,7 @@ -- package. ---------------------------------------------------------------------------- module GHC.Generics.Lens-  ( module Generics.Deriving.Lens-  , _V1+  ( _V1   , _U1   , _Par1   , _Rec1@@ -38,12 +38,22 @@   , _M1   , _L1   , _R1+  , _UAddr+  , _UChar+  , _UDouble+  , _UFloat+  , _UInt+  , _UWord   ) where  import Control.Lens-import Generics.Deriving.Lens+import GHC.Exts (Char(..), Double(..), Float(..), Int(..), Ptr(..), Word(..)) import GHC.Generics +#if !(MIN_VERSION_base(4,9,0))+import Generics.Deriving.Base+#endif+ _V1 :: Over p f (V1 s) (V1 t) a b _V1 _ = absurd where   absurd !_a = undefined@@ -86,3 +96,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 #-}
− src/Generics/Deriving/Lens.hs 
@@ -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 <ekmett@gmail.com>--- 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 #-}
src/System/FilePath/Lens.hs view
@@ -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 #-}