lens 3.8.7.3 → 3.9

raw patch · 54 files changed

+847/−677 lines, 54 filesdep ~contravariantdep ~semigroupoidssetup-changedbinary-addedPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: contravariant, semigroupoids

API changes (from Hackage documentation)

Files

• .travis.yml +2/−0
• AUTHORS.markdown +1/−0
• CHANGELOG.markdown +15/−0
• README.markdown +1/−1
• Setup.lhs +15/−4
• examples/Pong.hs +2/−2
• images/Hierarchy.png binary
• lens.cabal +5/−4
• src/Control/Exception/Lens.hs +8/−8
• src/Control/Lens.hs +1/−1
• src/Control/Lens/Action.hs +8/−0
• src/Control/Lens/At.hs +46/−37
• src/Control/Lens/Cons.hs +8/−7
• src/Control/Lens/Each.hs +6/−6
• src/Control/Lens/Fold.hs +151/−152
• src/Control/Lens/Getter.hs +34/−175
• src/Control/Lens/Indexed.hs +29/−2
• src/Control/Lens/Internal/Action.hs +5/−4
• src/Control/Lens/Internal/Bazaar.hs +6/−6
• src/Control/Lens/Internal/ByteString.hs +7/−8
• src/Control/Lens/Internal/Context.hs +4/−4
• src/Control/Lens/Internal/Deque.hs +5/−0
• src/Control/Lens/Internal/Exception.hs +4/−4
• src/Control/Lens/Internal/Fold.hs +5/−5
• src/Control/Lens/Internal/Getter.hs +23/−36
• src/Control/Lens/Internal/Indexed.hs +9/−9
• src/Control/Lens/Internal/Iso.hs +48/−0
• src/Control/Lens/Internal/Magma.hs +4/−3
• src/Control/Lens/Internal/Review.hs +14/−21
• src/Control/Lens/Internal/Setter.hs +10/−1
• src/Control/Lens/Internal/Zoom.hs +4/−3
• src/Control/Lens/Iso.hs +118/−35
• src/Control/Lens/Lens.hs +55/−22
• src/Control/Lens/Loupe.hs +0/−1
• src/Control/Lens/Operators.hs +1/−0
• src/Control/Lens/Plated.hs +8/−8
• src/Control/Lens/Prism.hs +3/−0
• src/Control/Lens/Review.hs +10/−6
• src/Control/Lens/TH.hs +37/−4
• src/Control/Lens/Traversal.hs +56/−25
• src/Control/Lens/Tuple.hs +1/−1
• src/Control/Lens/Type.hs +9/−9
• src/Control/Lens/Zoom.hs +8/−8
• src/Control/Monad/Error/Lens.hs +5/−5
• src/Control/Seq/Lens.hs +1/−1
• src/Data/Complex/Lens.hs +1/−1
• src/Data/HashSet/Lens.hs +1/−1
• src/Data/IntSet/Lens.hs +1/−1
• src/Data/List/Split/Lens.hs +15/−15
• src/Data/Set/Lens.hs +1/−1
• src/Data/Vector/Generic/Lens.hs +2/−12
• src/Data/Vector/Lens.hs +1/−11
• src/Numeric/Lens.hs +30/−6
• tests/doctests.hsc +3/−1

@@ -2,6 +2,7 @@ before_install:   # Uncomment whenever hackage is down.   # - mkdir -p ~/.cabal && cp travis/config ~/.cabal/config && cabal update+  - cabal update    # Try installing some of the build-deps with apt-get for speed.   - travis/cabal-apt-install $mode@@ -12,6 +13,7 @@  script:   - $script && hlint src --cpp-define HLINT+  - scripts/stats  notifications:   irc:

@@ -35,6 +35,7 @@ * Yair Chuchem [@yairchu](https://github.com/yairchu) * [Michael Thompson](mailto:what_is_it_to_do_anything@yahoo.com) [@michaelt](https://github.com/michaelt) * [John Wiegley](mailto:johnw@newartisans.com) [@jwiegley](https://github.com/jwiegley)+* [Jonathan Fischoff](mailto:jfischoff@yahoo.com) [@jfischoff](https://github.com/jfischoff)  You can watch them carry on the quest for bragging rights in the [contributors graph](https://github.com/ekmett/lens/graphs/contributors). 

@@ -1,3 +1,18 @@+3.9+-----+* Changed `Getting` to take 3 arguments instead of 5. If you need the old behavior for portability you can use+  `Overloaded (Accessor r) s t a b` instead of `Getting r s t a b` and it'll work consistently back through the last few releases.+* Added `involuted` to `Control.Lens.Iso`.+* Factored out a common `reversed` definition from all the various forms of it around the library and placed it in `Control.Lens.Iso`.+* Added `binary`, `octal`, `decimal` and `hex` to `Numeric.Lens`.+* Added `sans` to `Control.Lens.At`.+* Improved interoperability:+  * Reimplemented `Gettable` as an alias for `Contravariant` and `Functor` together to derive `Getter` and `Fold`. This means you can now+    implement a `Getter` or `Fold` with only a Haskell 98 dependency (`contravariant`).+  * Removed `Reviewable`. We now use `Bifunctor` and `Profunctor` together to derive `Review`. This means you can now implement a `Review`+    with Haskell 98 dependencies (`profunctors` and `bifunctors`).+  * These changes enables more types to be defined without incurring a dependency on the `lens` package.+ 3.8.7.0-3.8.7.3 [maintenance releases] ----- * Fixes to dependencies and pragmas.

@@ -71,7 +71,7 @@  ```haskell ghci> _1 .~ "hello" $ ((),"world")-("hello","world)+("hello","world") ```  Conversely `view`, can be used as a prefix alias for `(^.)`.

@@ -5,14 +5,15 @@  import Data.List ( nub ) import Data.Version ( showVersion )-import Distribution.Package ( PackageName(PackageName), PackageId, InstalledPackageId, packageVersion, packageName )+import Distribution.Package ( PackageName(PackageName), Package, PackageId, InstalledPackageId, packageVersion, packageName ) import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) ) import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks )-import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose )+import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose, copyFiles ) import Distribution.Simple.BuildPaths ( autogenModulesDir )-import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), fromFlag )+import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), Flag(..), fromFlag, HaddockFlags(haddockDistPref)) import Distribution.Simple.LocalBuildInfo ( withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps) )-import Distribution.Verbosity ( Verbosity )+import Distribution.Text ( display )+import Distribution.Verbosity ( Verbosity, normal ) import System.FilePath ( (</>) )  main :: IO ()@@ -20,7 +21,17 @@   { buildHook = \pkg lbi hooks flags -> do      generateBuildModule (fromFlag (buildVerbosity flags)) pkg lbi      buildHook simpleUserHooks pkg lbi hooks flags+  , postHaddock = \args flags pkg lbi -> do+     copyFiles normal (haddockOutputDir flags pkg) [("images","Hierarchy.png")]+     postHaddock simpleUserHooks args flags pkg lbi   }++haddockOutputDir :: Package p => HaddockFlags -> p -> FilePath+haddockOutputDir flags pkg = destDir where+  baseDir = case haddockDistPref flags of+    NoFlag -> "."+    Flag x -> x+  destDir = baseDir </> "doc" </> "html" </> display (packageName pkg)  generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO () generateBuildModule verbosity pkg lbi = do

@@ -111,7 +111,7 @@   p <- get    let paddleMovement = time * paddleSpeed-      keyPressed key = p^.keys.ix (SpecialKey key)+      keyPressed key = p^.keys.contains (SpecialKey key)    -- Update the player's paddle based on keys   when (keyPressed KeyUp)   $ paddle1 += paddleMovement@@ -205,7 +205,7 @@ -- Handle input by simply updating the keys set  handle :: Event -> Pong -> Pong-handle (EventKey k s _ _) = keys.ix k .~ (s == Down)+handle (EventKey k s _ _) = keys.contains k .~ (s == Down) handle _ = id  -- The main program action

binary file changed (absent → 260302 bytes)

@@ -1,6 +1,6 @@ name:          lens category:      Data, Lenses-version:       3.8.7.3+version:       3.9 license:       BSD3 cabal-version: >= 1.8 license-file:  LICENSE@@ -37,7 +37,7 @@   .   The core of the hierarchy of lens-like constructions looks like:   .-  <<http://i.imgur.com/RFi75.png>>+  <<Hierarchy.png>>   .   You can compose any two elements of the hierarchy above using @(.)@ from the @Prelude@, and you can   use any element of the hierarchy as any type it linked to above it.@@ -91,6 +91,7 @@   examples/*.hs   examples/*.lhs   examples/bf-examples/*.bf+  images/*.png   travis/cabal-apt-install   travis/config   AUTHORS.markdown@@ -167,7 +168,7 @@     comonad                   >= 3        && < 4,     comonad-transformers      >= 3        && < 4,     comonads-fd               >= 3        && < 4,-    contravariant             >= 0.2.0.2  && < 1,+    contravariant             >= 0.3      && < 1,     containers                >= 0.4.0    && < 0.6,     distributive              >= 0.3      && < 1,     filepath                  >= 1.2.0.0  && < 1.4,@@ -180,7 +181,7 @@     profunctors               >= 3.2      && < 4,     profunctor-extras         >= 3.3      && < 4,     reflection                >= 1.1.6    && < 2,-    semigroupoids             >= 3        && < 4,+    semigroupoids             >= 3.0.2    && < 4,     semigroups                >= 0.8.4    && < 1,     split                     == 0.2.*,     tagged                    >= 0.4.4    && < 1,

@@ -126,11 +126,11 @@ -- the desired 'Exception'. -- -- @--- 'exception' :: ('Applicative' f, 'Exception' a, 'Exception' b)---           => (a -> f b) -> 'SomeException' -> f 'SomeException'+-- 'exception' :: ('Applicative' f, 'Exception' a)+--           => (a -> f a) -> 'SomeException' -> f 'SomeException' -- @ exception :: Exception a => Prism' SomeException a-exception = prism toException $ \ e -> maybe (Left e) Right $ fromException e+exception = prism' toException fromException {-# INLINE exception #-}  ------------------------------------------------------------------------------@@ -150,7 +150,7 @@ -- 'catching' :: 'MonadCatchIO' m => 'Getter' 'SomeException' a     -> m r -> (a -> m r) -> m r -- 'catching' :: 'MonadCatchIO' m => 'Fold' 'SomeException' a       -> m r -> (a -> m r) -> m r -- @-catching :: MonadCatchIO m => Getting (First a) SomeException t a b -> m r -> (a -> m r) -> m r+catching :: MonadCatchIO m => Getting (First a) SomeException a -> m r -> (a -> m r) -> m r catching l = catchJust (preview l) {-# INLINE catching #-} @@ -170,7 +170,7 @@ -- 'catching_' :: 'MonadCatchIO' m => 'Getter' 'SomeException' a     -> m r -> m r -> m r -- 'catching_' :: 'MonadCatchIO' m => 'Fold' 'SomeException' a       -> m r -> m r -> m r -- @-catching_ :: MonadCatchIO m => Getting (First a) SomeException t a b -> m r -> m r -> m r+catching_ :: MonadCatchIO m => Getting (First a) SomeException a -> m r -> m r -> m r catching_ l a b = catchJust (preview l) a (const b) {-# INLINE catching_ #-} @@ -199,7 +199,7 @@ -- 'handling' :: 'MonadCatchIO' m => 'Fold' 'SomeException' a       -> (a -> m r) -> m r -> m r -- 'handling' :: 'MonadCatchIO' m => 'Getter' 'SomeException' a     -> (a -> m r) -> m r -> m r -- @-handling :: MonadCatchIO m => Getting (First a) SomeException t a b -> (a -> m r) -> m r -> m r+handling :: MonadCatchIO m => Getting (First a) SomeException a -> (a -> m r) -> m r -> m r handling l = flip (catching l) {-# INLINE handling #-} @@ -217,7 +217,7 @@ -- 'handling_' :: 'MonadCatchIO' m => 'Getter' 'SomeException' a     -> m r -> m r -> m r -- 'handling_' :: 'MonadCatchIO' m => 'Fold' 'SomeException' a       -> m r -> m r -> m r -- @-handling_ :: MonadCatchIO m => Getting (First a) SomeException t a b -> m r -> m r -> m r+handling_ :: MonadCatchIO m => Getting (First a) SomeException a -> m r -> m r -> m r handling_ l = flip (catching_ l) {-# INLINE handling_ #-} @@ -237,7 +237,7 @@ -- 'trying' :: 'MonadCatchIO' m => 'Getter'     'SomeException' a -> m r -> m ('Either' a r) -- 'trying' :: 'MonadCatchIO' m => 'Fold'       'SomeException' a -> m r -> m ('Either' a r) -- @-trying :: MonadCatchIO m => Getting (First a) SomeException t a b -> m r -> m (Either a r)+trying :: MonadCatchIO m => Getting (First a) SomeException a -> m r -> m (Either a r) trying l = tryJust (preview l)  -- | A helper version of 'Control.Exception.try' that doesn't needlessly require 'Functor'.

@@ -37,7 +37,7 @@ -- -- <http://github.com/ekmett/lens/wiki> ----- <<http://github.com/ekmett/lens/wiki/images/Hierarchy-3.8.png>>+-- <<Hierarchy.png>> ---------------------------------------------------------------------------- module Control.Lens   ( module Control.Lens.Action

@@ -91,6 +91,9 @@ {-# INLINE (^!) #-}  -- | Perform a 'MonadicFold' and collect all of the results in a list.+--+-- >>> ["ab","cd","ef"]^!!folded.acts+-- ["ace","acf","ade","adf","bce","bcf","bde","bdf"] (^!!) :: Monad m => s -> Acting m [a] s t a b -> m [a] a ^!! l = getEffect (l (Effect #. return . return) a) {-# INLINE (^!!) #-}@@ -98,6 +101,11 @@ -- | Perform a 'MonadicFold' and collect the leftmost result. -- -- /Note:/ this still causes all effects for all elements.+--+-- >>> [Just 1, Just 2, Just 3]^!?folded.acts+-- Just (Just 1)+-- >>> [Just 1, Nothing]^!?folded.acts+-- Nothing (^!?) :: Monad m => s -> Acting m (Leftmost a) s t a b -> m (Maybe a) a ^!?  l = liftM getLeftmost .# getEffect $ l (Effect #. return . LLeaf) a {-# INLINE (^!?) #-}

@@ -6,6 +6,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE UndecidableInstances #-}  #ifdef DEFAULT_SIGNATURES {-# LANGUAGE DefaultSignatures #-}@@ -31,7 +32,7 @@ module Control.Lens.At   (   -- * At-    At(at)+    At(at), sans   -- * Ixed   , IxValue   , Ixed(ix)@@ -50,6 +51,7 @@ import Control.Lens.Fold import Control.Lens.Getter import Control.Lens.Indexed as Lens+import Control.Lens.Setter import Control.Lens.Type import Control.Lens.Traversal import Data.Array.IArray as Array@@ -89,7 +91,7 @@ _at, resultAt :: Ixed f m => Index m -> IndexedLensLike' (Index m) f m (IxValue m) _at      = ix resultAt = ix-{-# DEPRECATED _at, resultAt "use 'ix'. This function will be removed in version 3.9" #-}+{-# DEPRECATED _at, resultAt "use 'ix'. This function will be removed after GHC 7.8 is released." #-}  -- | -- This class provides a simple 'IndexedFold' (or 'IndexedTraversal') that lets you view (and modify)@@ -106,18 +108,18 @@   -- fromList [1,2,4]   contains :: Index m -> IndexedLensLike' (Index m) f m Bool #ifdef DEFAULT_SIGNATURES-  default contains :: (Gettable f, At m) => Index m -> IndexedLensLike' (Index m) f m Bool+  default contains :: (Contravariant f, Functor f, At m) => Index m -> IndexedLensLike' (Index m) f m Bool   contains = containsAt #endif  -- | A definition of 'contains' for types with an 'Ix' instance.-containsIx :: (Gettable f, Ixed (Accessor Any) m) => Index m -> IndexedLensLike' (Index m) f m Bool+containsIx :: (Contravariant f, Functor f, Ixed (Accessor Any) m) => Index m -> IndexedLensLike' (Index m) f m Bool containsIx i f = coerce . Lens.indexed f i . has (ix i) {-# INLINE containsIx #-}  -- | A definition of 'ix' for types with an 'At' instance. This is the default -- if you don't specify a definition for 'contains' and you are on GHC >= 7.0.2-containsAt :: (Gettable f, At m) => Index m -> IndexedLensLike' (Index m) f m Bool+containsAt :: (Contravariant f, Functor f, At m) => Index m -> IndexedLensLike' (Index m) f m Bool containsAt i f = coerce . Lens.indexed f i . views (at i) isJust {-# INLINE containsAt #-} @@ -141,7 +143,7 @@ containsLookup isb = \i pafb s -> coerce $ Lens.indexed pafb (i :: i) (isJust (isb i s)) {-# INLINE containsLookup #-} -instance Gettable f => Contains f (e -> a) where+instance (Functor f, Contravariant f) => Contains f (e -> a) where   contains i f _ = coerce (Lens.indexed f i True)   {-# INLINE contains #-} @@ -160,118 +162,119 @@     if b then HashSet.insert k s else HashSet.delete k s   {-# INLINE contains #-} -instance Gettable f => Contains f [a] where+instance (Contravariant f, Functor f) => Contains f [a] where   contains = containsLength Prelude.length   {-# INLINE contains #-} -instance Gettable f => Contains f (Seq a) where+instance (Contravariant f, Functor f) => Contains f (Seq a) where   contains = containsLength Seq.length   {-# INLINE contains #-}  #if MIN_VERSION_base(4,4,0)-instance Gettable f => Contains f (Complex a) where+instance (Contravariant f, Functor f) => Contains f (Complex a) where   contains = containsN 2   {-# INLINE contains #-} #else-instance (Gettable f, RealFloat a) => Contains f (Complex a) where+instance (Contravariant f, Functor f, RealFloat a) => Contains f (Complex a) where   contains = containsN 2   {-# INLINE contains #-} #endif -instance Gettable f => Contains f (Tree a) where+instance (Contravariant f, Functor f) => Contains f (Tree a) where   contains xs0 pafb = coerce . Lens.indexed pafb xs0 . go xs0 where     go [] (Node _ _) = True-    go (i:is) (Node _ as) = goto i is as+    go (i:is) (Node _ as) | i < 0     = False+                          | otherwise = goto i is as     goto 0 is (a:_) = go is a     goto _ _  []     = False     goto n is (_:as) = (goto $! n - 1) is as   {-# INLINE contains #-} -instance Gettable k => Contains k (Identity a) where+instance (Contravariant k, Functor k) => Contains k (Identity a) where   contains () f _ = coerce (Lens.indexed f () True)   {-# INLINE contains #-} -instance Gettable k => Contains k (a,b) where+instance (Contravariant k, Functor k) => Contains k (a,b) where   contains = containsN 2   {-# INLINE contains #-} -instance Gettable k => Contains k (a,b,c) where+instance (Contravariant k, Functor k) => Contains k (a,b,c) where   contains = containsN 3   {-# INLINE contains #-} -instance Gettable k => Contains k (a,b,c,d) where+instance (Contravariant k, Functor k) => Contains k (a,b,c,d) where   contains = containsN 4   {-# INLINE contains #-} -instance Gettable k => Contains k (a,b,c,d,e) where+instance (Contravariant k, Functor k) => Contains k (a,b,c,d,e) where   contains = containsN 5   {-# INLINE contains #-} -instance Gettable k => Contains k (a,b,c,d,e,f) where+instance (Contravariant k, Functor k) => Contains k (a,b,c,d,e,f) where   contains = containsN 6   {-# INLINE contains #-} -instance Gettable k => Contains k (a,b,c,d,e,f,g) where+instance (Contravariant k, Functor k) => Contains k (a,b,c,d,e,f,g) where   contains = containsN 7   {-# INLINE contains #-} -instance Gettable k => Contains k (a,b,c,d,e,f,g,h) where+instance (Contravariant k, Functor k) => Contains k (a,b,c,d,e,f,g,h) where   contains = containsN 8   {-# INLINE contains #-} -instance Gettable k => Contains k (a,b,c,d,e,f,g,h,i) where+instance (Contravariant k, Functor k) => Contains k (a,b,c,d,e,f,g,h,i) where   contains = containsN 9   {-# INLINE contains #-} -instance Gettable k => Contains k (IntMap a) where+instance (Contravariant k, Functor k) => Contains k (IntMap a) where   contains = containsLookup IntMap.lookup   {-# INLINE contains #-} -instance (Gettable f, Ord k) => Contains f (Map k a) where+instance (Contravariant f, Functor f, Ord k) => Contains f (Map k a) where   contains = containsLookup Map.lookup   {-# INLINE contains #-} -instance (Gettable f, Eq k, Hashable k) => Contains f (HashMap k a) where+instance (Contravariant f, Functor f, Eq k, Hashable k) => Contains f (HashMap k a) where   contains = containsLookup HashMap.lookup   {-# INLINE contains #-} -instance (Gettable f, Ix i) => Contains f (Array i e) where+instance (Contravariant f, Functor f, Ix i) => Contains f (Array i e) where   contains = containsTest $ \i s -> inRange (bounds s) i   {-# INLINE contains #-} -instance (Gettable f, IArray UArray e, Ix i) => Contains f (UArray i e) where+instance (Contravariant f, Functor f, IArray UArray e, Ix i) => Contains f (UArray i e) where   contains = containsTest $ \i s -> inRange (bounds s) i   {-# INLINE contains #-} -instance Gettable f => Contains f (Vector.Vector a) where+instance (Contravariant f, Functor f) => Contains f (Vector.Vector a) where   contains = containsLength Vector.length   {-# INLINE contains #-} -instance (Gettable f, Prim a) => Contains f (Prim.Vector a) where+instance (Contravariant f, Functor f, Prim a) => Contains f (Prim.Vector a) where   contains = containsLength Prim.length   {-# INLINE contains #-} -instance (Gettable f, Storable a) => Contains f (Storable.Vector a) where+instance (Contravariant f, Functor f, Storable a) => Contains f (Storable.Vector a) where   contains = containsLength Storable.length   {-# INLINE contains #-} -instance (Gettable f, Unbox a) => Contains f (Unboxed.Vector a) where+instance (Contravariant f, Functor f, Unbox a) => Contains f (Unboxed.Vector a) where   contains = containsLength Unboxed.length   {-# INLINE contains #-} -instance Gettable f => Contains f StrictT.Text where+instance (Contravariant f, Functor f) => Contains f StrictT.Text where   contains = containsTest $ \i s -> StrictT.compareLength s i == GT   {-# INLINE contains #-} -instance Gettable f => Contains f LazyT.Text where+instance (Contravariant f, Functor f) => Contains f LazyT.Text where   contains = containsTest $ \i s -> LazyT.compareLength s i == GT   {-# INLINE contains #-} -instance Gettable f => Contains f StrictB.ByteString where+instance (Contravariant f, Functor f) => Contains f StrictB.ByteString where   contains = containsLength StrictB.length   {-# INLINE contains #-} -instance Gettable f => Contains f LazyB.ByteString where+instance (Contravariant f, Functor f) => Contains f LazyB.ByteString where   contains = containsTest $ \i s -> not (LazyB.null (LazyB.drop i s))   {-# INLINE contains #-} @@ -280,7 +283,7 @@  -- | This simple 'IndexedTraversal' lets you 'traverse' the value at a given -- key in a 'Map' or element at an ordinal position in a list or 'Seq'.-class (Functor f, Contains (Accessor (IxValue m)) m) => Ixed f m where+class Functor f => Ixed f m where   -- | This simple 'IndexedTraversal' lets you 'traverse' the value at a given   -- key in a 'Map' or element at an ordinal position in a list or 'Seq'.   --@@ -320,7 +323,8 @@  type instance IxValue [a] = a instance Applicative f => Ixed f [a] where-  ix k f xs0 = go xs0 k where+  ix k f xs0 | k < 0     = pure xs0+             | otherwise = go xs0 k where     go [] _ = pure []     go (a:as) 0 = Lens.indexed f k a <&> (:as)     go (a:as) i = (a:) <$> (go as $! i - 1)@@ -335,7 +339,8 @@ instance Applicative f => Ixed f (Tree a) where   ix xs0 f = go xs0 where     go [] (Node a as) = Lens.indexed f xs0 a <&> \a' -> Node a' as-    go (i:is) (Node a as) = Node a <$> goto is as i+    go (i:is) t@(Node a as) | i < 0     = pure t+                            | otherwise = Node a <$> goto is as i     goto is (a:as) 0 = go is a <&> (:as)     goto is (_:as) n = goto is as $! n - 1     goto _  []     _ = pure []@@ -530,6 +535,10 @@   -- /Note:/ 'Map'-like containers form a reasonable instance, but not 'Array'-like ones, where   -- you cannot satisfy the 'Lens' laws.   at :: Index m -> IndexedLens' (Index m) m (Maybe (IxValue m))++sans :: At m => Index m -> m -> m+sans k m = m & at k .~ Nothing+{-# INLINE sans #-}  instance At (IntMap a) where   at k f m = Lens.indexed f k mv <&> \r -> case r of

@@ -155,6 +155,7 @@ -- | 'cons' an element onto a container. cons :: Cons Reviewed Identity s s a a => a -> s -> s cons = curry (simply review _Cons)+{-# INLINE cons #-}  -- | Attempt to extract the left-most element from a container, and a version of the container without that element. uncons :: Cons (->) (Accessor (First (a, s))) s s a a => s -> Maybe (a, s)@@ -274,7 +275,7 @@   -- | Most of the time this is a 'Prism'.   --   -- @-  -- '_Snoc' :: 'Prism' [a] [b] (a, [a]) (b, [b])+  -- '_Snoc' :: 'Prism' [a] [b] ([a], a) ([b], b)   -- '_Snoc' :: 'Prism' ('Seq' a) ('Seq' b) ('Seq' a, a) ('Seq' b, b)   -- '_Snoc' :: 'Prism' ('Vector' a) ('Vector' b) ('Vector' a, a) ('Vector' b, b)   -- '_Snoc' :: 'Prism'' 'String' ('String', 'Char')@@ -376,9 +377,9 @@ -- "" -- -- @--- '_init' :: 'Traversal'' [a] a--- '_init' :: 'Traversal'' ('Seq' a) a--- '_init' :: 'Traversal'' ('Vector' a) a+-- '_init' :: 'Traversal'' [a] [a]+-- '_init' :: 'Traversal'' ('Seq' a) ('Seq' a)+-- '_init' :: 'Traversal'' ('Vector' a) ('Vector' a) -- @ _init :: Snoc (->) f s s a a => LensLike' f s s _init = _Snoc._1@@ -419,9 +420,9 @@ -- fromList "abcdQ" -- -- @--- '_last' :: 'Traversal'' [a] [a]--- '_last' :: 'Traversal'' ('Seq' a) ('Seq' a)--- '_last' :: 'Traversal'' ('Vector' a) ('Vector' a)+-- '_last' :: 'Traversal'' [a] a+-- '_last' :: 'Traversal'' ('Seq' a) a+-- '_last' :: 'Traversal'' ('Vector' a) a -- @ _last :: Snoc (->) f s s a a => LensLike' f s a _last = _Snoc._2

@@ -203,7 +203,7 @@     where f' = Lens.indexed f   {-# INLINE each #-} --- | @'each' :: 'IndexedTraversal' 'Int' ('Map' c a) ('Map' c b) a b@+-- | @'each' :: 'IndexedTraversal' c ('Map' c a) ('Map' c b) a b@ instance Applicative f => Each f (IntMap a) (IntMap b) a b where   each f m = sequenceA $ IntMap.mapWithKey f' m     where f' = Lens.indexed f@@ -219,12 +219,12 @@   each = traversed   {-# INLINE each #-} --- | @'each' :: 'IndexedTraversal' 'Int' ('Identity' a) ('Identity' b) a b@+-- | @'each' :: 'IndexedTraversal' () ('Identity' a) ('Identity' b) a b@ instance Functor f => Each f (Identity a) (Identity b) a b where   each f (Identity a) = Identity <$> Lens.indexed f () a   {-# INLINE each #-} --- | @'each' :: 'IndexedTraversal' 'Int' ('Maybe' a) ('Maybe' b) a b@+-- | @'each' :: 'IndexedTraversal' () ('Maybe' a) ('Maybe' b) a b@ instance Applicative f => Each f (Maybe a) (Maybe b) a b where   each f (Just a) = Just <$> Lens.indexed f () a   each _ Nothing  = pure Nothing@@ -274,12 +274,12 @@   each = iso LazyT.unpack LazyT.pack . traversed64   {-# INLINE each #-} --- | @'each' :: 'IndexedTraversal' 'Int' 'StrictB.ByteString' 'StrictB.ByteString' 'Char' 'Char'@+-- | @'each' :: 'IndexedTraversal' 'Int' 'StrictB.ByteString' 'StrictB.ByteString' 'Word8' 'Word8'@ instance Applicative f => Each f StrictB.ByteString StrictB.ByteString Word8 Word8 where   each = iso StrictB.unpack StrictB.pack . traversed   {-# INLINE each #-} --- | @'each' :: 'IndexedTraversal' 'Int64' 'LazyB.ByteString' 'LazyB.ByteString' 'Char' 'Char'@+-- | @'each' :: 'IndexedTraversal' 'Int64' 'LazyB.ByteString' 'LazyB.ByteString' 'Word8' 'Word8'@ instance Applicative f => Each f LazyB.ByteString LazyB.ByteString Word8 Word8 where   each = iso LazyB.unpack LazyB.pack . traversed64   {-# INLINE each #-}@@ -294,7 +294,7 @@   each f arr = array (bounds arr) <$> traverse (\(i,a) -> (,) i <$> Lens.indexed f i a) (IArray.assocs arr)   {-# INLINE each #-} --- | @'each' :: 'Control.Lens.IndexedSetter.IndexedSetter' i (i -> a) (i -> b) a b@+-- | @'each' :: 'Control.Lens.IndexedSetter' i (i -> a) (i -> b) a b@ instance Settable f => Each f (i -> a) (i -> b) a b where   each f g = pure (\i -> untaintedDot (Lens.indexed f i) (g i))   {-# INLINE each #-}

@@ -6,6 +6,8 @@ #ifdef TRUSTWORTHY {-# LANGUAGE Trustworthy #-} #endif++{-# OPTIONS_GHC -fno-warn-orphans #-} ---------------------------------------------------------------------------- -- | -- Module      :  Control.Lens.Fold@@ -23,7 +25,7 @@ -- generalize this signature to @forall m. 'Monoid' m => (a -> m) -> s -> m@, -- and then decorate it with 'Accessor' to obtain ----- @type 'Fold' s a = forall m. 'Monoid' m => 'Getting' m s s a a@+-- @type 'Fold' s a = forall m. 'Monoid' m => 'Getting' m s a@ -- -- Every 'Getter' is a valid 'Fold' that simply doesn't use the 'Monoid' -- it is passed.@@ -134,7 +136,7 @@ import Control.Lens.Internal.Indexed import Control.Lens.Internal.Magma import Control.Lens.Type-import Control.Monad+import Control.Monad as Monad import Control.Monad.Reader import Control.Monad.State import Data.Foldable as Foldable@@ -177,7 +179,7 @@ -- -- >>> [1,2,3,4]^..folding tail -- [2,3,4]-folding :: (Foldable f, Applicative g, Gettable g) => (s -> f a) -> LensLike g s t a b+folding :: (Foldable f, Contravariant g, Applicative g) => (s -> f a) -> LensLike g s t a b folding sfa agb = coerce . traverse_ agb . sfa {-# INLINE folding #-} @@ -226,7 +228,7 @@ -- -- >>> timingOut $ [1,2,3]^..taking 7 (cycled traverse) -- [1,2,3,1,2,3,1]-cycled :: (Applicative f, Gettable f) => LensLike f s t a b -> LensLike f s t a b+cycled :: (Contravariant f, Applicative f) => LensLike f s t a b -> LensLike f s t a b cycled l f a = as where as = l f a *> as {-# INLINE cycled #-} @@ -338,7 +340,7 @@ -- 'droppingWhile' :: (a -> 'Bool') -> 'IndexPreservingLens'' s a         -> 'IndexPreservingFold' s a -- see notes -- 'droppingWhile' :: (a -> 'Bool') -> 'IndexPreservingGetter' s a        -> 'IndexPreservingFold' s a -- 'droppingWhile' :: (a -> 'Bool') -> 'IndexPreservingFold' s a          -> 'IndexPreservingFold' s a--- 'droppingWhile' :: (a -> 'Bool') -> 'IndexPreservingAction' m s a      -> 'IndexPreservingFold' m s a+-- 'droppingWhile' :: (a -> 'Bool') -> 'IndexPreservingAction' m s a      -> 'IndexPreservingFold' s a -- @ -- -- @@@ -350,7 +352,7 @@ -- 'droppingWhile' :: (a -> 'Bool') -> 'IndexedLens'' i s a               -> 'IndexedFold' i s a       -- see notes -- 'droppingWhile' :: (a -> 'Bool') -> 'IndexedGetter' i s a              -> 'IndexedFold' i s a -- 'droppingWhile' :: (a -> 'Bool') -> 'IndexedFold' i s a                -> 'IndexedFold' i s a--- 'droppingWhile' :: (a -> 'Bool') -> 'IndexedAction' i m s a            -> 'IndexedFold' i m s a+-- 'droppingWhile' :: (a -> 'Bool') -> 'IndexedAction' i m s a            -> 'IndexedFold' i s a -- @ -- -- @@@ -395,9 +397,9 @@ -- @ -- -- @--- 'foldMapOf' :: 'Getting' r s t a b -> (a -> r) -> s -> r+-- 'foldMapOf' :: 'Getting' r s a -> (a -> r) -> s -> r -- @-foldMapOf :: Profunctor p => Accessing p r s t a b -> p a r -> s -> r+foldMapOf :: Profunctor p => Accessing p r s a -> p a r -> s -> r foldMapOf l f = runAccessor #. l (Accessor #. f) {-# INLINE foldMapOf #-} @@ -417,7 +419,7 @@ -- 'foldOf' :: 'Monoid' m => 'Traversal'' s m -> s -> m -- 'foldOf' :: 'Monoid' m => 'Prism'' s m     -> s -> m -- @-foldOf :: Getting a s t a b -> s -> a+foldOf :: Getting a s a -> s -> a foldOf l = runAccessor #. l Accessor {-# INLINE foldOf #-} @@ -441,9 +443,9 @@ -- @ -- -- @--- 'foldrOf' :: 'Getting' ('Endo' r) s t a b -> (a -> r -> r) -> r -> s -> r+-- 'foldrOf' :: 'Getting' ('Endo' r) s a -> (a -> r -> r) -> r -> s -> r -- @-foldrOf :: Profunctor p => Accessing p (Endo r) s t a b -> p a (r -> r) -> r -> s -> r+foldrOf :: Profunctor p => Accessing p (Endo r) s a -> p a (r -> r) -> r -> s -> r foldrOf l f z = flip appEndo z `rmap` foldMapOf l (Endo #. f) {-# INLINE foldrOf #-} @@ -461,7 +463,7 @@ -- 'foldlOf' :: 'Traversal'' s a -> (r -> a -> r) -> r -> s -> r -- 'foldlOf' :: 'Prism'' s a     -> (r -> a -> r) -> r -> s -> r -- @-foldlOf :: Getting (Dual (Endo r)) s t a b -> (r -> a -> r) -> r -> s -> r+foldlOf :: Getting (Dual (Endo r)) s a -> (r -> a -> r) -> r -> s -> r foldlOf l f z = (flip appEndo z .# getDual) `rmap` foldMapOf l (Dual #. Endo #. flip f) {-# INLINE foldlOf #-} @@ -483,7 +485,7 @@ -- 'toListOf' :: 'Traversal'' s a -> s -> [a] -- 'toListOf' :: 'Prism'' s a     -> s -> [a] -- @-toListOf :: Getting (Endo [a]) s t a b -> s -> [a]+toListOf :: Getting (Endo [a]) s a -> s -> [a] toListOf l = foldrOf l (:) [] {-# INLINE toListOf #-} @@ -508,7 +510,7 @@ -- ('^..') :: s -> 'Traversal'' s a -> [a] -- ('^..') :: s -> 'Prism'' s a     -> [a] -- @-(^..) :: s -> Getting (Endo [a]) s t a b -> [a]+(^..) :: s -> Getting (Endo [a]) s a -> [a] s ^.. l = toListOf l s {-# INLINE (^..) #-} @@ -531,7 +533,7 @@ -- 'andOf' :: 'Traversal'' s 'Bool' -> s -> 'Bool' -- 'andOf' :: 'Prism'' s 'Bool'     -> s -> 'Bool' -- @-andOf :: Getting All s t Bool b -> s -> Bool+andOf :: Getting All s Bool -> s -> Bool andOf l = getAll #. foldMapOf l All {-# INLINE andOf #-} @@ -554,7 +556,7 @@ -- 'orOf' :: 'Traversal'' s 'Bool' -> s -> 'Bool' -- 'orOf' :: 'Prism'' s 'Bool'     -> s -> 'Bool' -- @-orOf :: Getting Any s t Bool b -> s -> Bool+orOf :: Getting Any s Bool -> s -> Bool orOf l = getAny #. foldMapOf l Any {-# INLINE orOf #-} @@ -582,7 +584,7 @@ -- 'anyOf' :: 'Traversal'' s a -> (a -> 'Bool') -> s -> 'Bool' -- 'anyOf' :: 'Prism'' s a     -> (a -> 'Bool') -> s -> 'Bool' -- @-anyOf :: Profunctor p => Accessing p Any s t a b -> p a Bool -> s -> Bool+anyOf :: Profunctor p => Accessing p Any s a -> p a Bool -> s -> Bool anyOf l f = getAny #. foldMapOf l (Any #. f) {-# INLINE anyOf #-} @@ -609,7 +611,7 @@ -- 'allOf' :: 'Traversal'' s a -> (a -> 'Bool') -> s -> 'Bool' -- 'allOf' :: 'Prism'' s a     -> (a -> 'Bool') -> s -> 'Bool' -- @-allOf :: Profunctor p => Accessing p All s t a b -> p a Bool -> s -> Bool+allOf :: Profunctor p => Accessing p All s a -> p a Bool -> s -> Bool allOf l f = getAll #. foldMapOf l (All #. f) {-# INLINE allOf #-} @@ -635,7 +637,7 @@ -- 'productOf' :: 'Num' a => 'Traversal'' s a -> s -> a -- 'productOf' :: 'Num' a => 'Prism'' s a     -> s -> a -- @-productOf :: Num a => Getting (Endo (Endo a)) s t a b -> s -> a+productOf :: Num a => Getting (Endo (Endo a)) s a -> s -> a productOf l = foldlOf' l (*) 1 {-# INLINE productOf #-} @@ -659,7 +661,7 @@ -- want a lazier version use @'ala' 'Sum' '.' 'foldMapOf'@ -- -- @--- 'sumOf' '_1' :: (a, b) -> a+-- 'sumOf' '_1' :: 'Num' a => (a, b) -> a -- 'sumOf' ('folded' '.' 'Control.Lens.Tuple._1') :: ('Foldable' f, 'Num' a) => f (a, b) -> a -- @ --@@ -671,7 +673,7 @@ -- 'sumOf' :: 'Num' a => 'Traversal'' s a -> s -> a -- 'sumOf' :: 'Num' a => 'Prism'' s a     -> s -> a -- @-sumOf :: Num a => Getting (Endo (Endo a)) s t a b -> s -> a+sumOf :: Num a => Getting (Endo (Endo a)) s a -> s -> a sumOf l = foldlOf' l (+) 0 {-# INLINE sumOf #-} @@ -692,7 +694,7 @@ -- -- @ -- 'traverseOf_' '_2' :: 'Functor' f => (c -> f r) -> (d, c) -> f ()--- 'traverseOf_' 'Data.Either.Lens.traverseLeft' :: 'Applicative' f => (a -> f b) -> 'Either' a c -> f ()+-- 'traverseOf_' 'Control.Lens.Prism._Left' :: 'Applicative' f => (a -> f b) -> 'Either' a c -> f () -- @ -- -- @@@ -709,7 +711,7 @@ -- 'traverseOf_' :: 'Applicative' f => 'Traversal'' s a -> (a -> f r) -> s -> f () -- 'traverseOf_' :: 'Applicative' f => 'Prism'' s a     -> (a -> f r) -> s -> f () -- @-traverseOf_ :: (Profunctor p, Functor f) => Accessing p (Traversed r f) s t a b -> p a (f r) -> s -> f ()+traverseOf_ :: (Profunctor p, Functor f) => Accessing p (Traversed r f) s a -> p a (f r) -> s -> f () traverseOf_ l f = void . getTraversed #. foldMapOf l (Traversed #. f) {-# INLINE traverseOf_ #-} @@ -742,7 +744,7 @@ -- 'forOf_' :: 'Applicative' f => 'Traversal'' s a -> s -> (a -> f r) -> f () -- 'forOf_' :: 'Applicative' f => 'Prism'' s a     -> s -> (a -> f r) -> f () -- @-forOf_ :: (Profunctor p, Functor f) => Accessing p (Traversed r f) s t a b -> s -> p a (f r) -> f ()+forOf_ :: (Profunctor p, Functor f) => Accessing p (Traversed r f) s a -> s -> p a (f r) -> f () forOf_ = flip . traverseOf_ {-# INLINE forOf_ #-} @@ -764,7 +766,7 @@ -- 'sequenceAOf_' :: 'Applicative' f => 'Traversal'' s (f a) -> s -> f () -- 'sequenceAOf_' :: 'Applicative' f => 'Prism'' s (f a)     -> s -> f () -- @-sequenceAOf_ :: Functor f => Getting (Traversed a f) s t (f a) b -> s -> f ()+sequenceAOf_ :: Functor f => Getting (Traversed a f) s (f a) -> s -> f () sequenceAOf_ l = void . getTraversed #. foldMapOf l Traversed {-# INLINE sequenceAOf_ #-} @@ -786,7 +788,7 @@ -- 'mapMOf_' :: 'Monad' m => 'Traversal'' s a -> (a -> m r) -> s -> m () -- 'mapMOf_' :: 'Monad' m => 'Prism'' s a     -> (a -> m r) -> s -> m () -- @-mapMOf_ :: (Profunctor p, Monad m) => Accessing p (Sequenced r m) s t a b -> p a (m r) -> s -> m ()+mapMOf_ :: (Profunctor p, Monad m) => Accessing p (Sequenced r m) s a -> p a (m r) -> s -> m () mapMOf_ l f = liftM skip . getSequenced #. foldMapOf l (Sequenced #. f) {-# INLINE mapMOf_ #-} @@ -808,7 +810,7 @@ -- 'forMOf_' :: 'Monad' m => 'Traversal'' s a -> s -> (a -> m r) -> m () -- 'forMOf_' :: 'Monad' m => 'Prism'' s a     -> s -> (a -> m r) -> m () -- @-forMOf_ :: (Profunctor p, Monad m) => Accessing p (Sequenced r m) s t a b -> s -> p a (m r) -> m ()+forMOf_ :: (Profunctor p, Monad m) => Accessing p (Sequenced r m) s a -> s -> p a (m r) -> m () forMOf_ = flip . mapMOf_ {-# INLINE forMOf_ #-} @@ -830,7 +832,7 @@ -- 'sequenceOf_' :: 'Monad' m => 'Traversal'' s (m a) -> s -> m () -- 'sequenceOf_' :: 'Monad' m => 'Prism'' s (m a)     -> s -> m () -- @-sequenceOf_ :: Monad m => Getting (Sequenced a m) s t (m a) b -> s -> m ()+sequenceOf_ :: Monad m => Getting (Sequenced a m) s (m a) -> s -> m () sequenceOf_ l = liftM skip . getSequenced #. foldMapOf l Sequenced {-# INLINE sequenceOf_ #-} @@ -847,14 +849,14 @@ -- @ -- -- @--- 'asumOf' :: 'Alternative' f => 'Getter' s a     -> s -> f a--- 'asumOf' :: 'Alternative' f => 'Fold' s a       -> s -> f a--- 'asumOf' :: 'Alternative' f => 'Lens'' s a      -> s -> f a--- 'asumOf' :: 'Alternative' f => 'Iso'' s a       -> s -> f a--- 'asumOf' :: 'Alternative' f => 'Traversal'' s a -> s -> f a--- 'asumOf' :: 'Alternative' f => 'Prism'' s a     -> s -> f a+-- 'asumOf' :: 'Alternative' f => 'Getter' s (f a)     -> s -> f a+-- 'asumOf' :: 'Alternative' f => 'Fold' s (f a)       -> s -> f a+-- 'asumOf' :: 'Alternative' f => 'Lens'' s (f a)      -> s -> f a+-- 'asumOf' :: 'Alternative' f => 'Iso'' s (f a)       -> s -> f a+-- 'asumOf' :: 'Alternative' f => 'Traversal'' s (f a) -> s -> f a+-- 'asumOf' :: 'Alternative' f => 'Prism'' s (f a)     -> s -> f a -- @-asumOf :: Alternative f => Getting (Endo (f a)) s t (f a) b -> s -> f a+asumOf :: Alternative f => Getting (Endo (f a)) s (f a) -> s -> f a asumOf l = foldrOf l (<|>) Applicative.empty {-# INLINE asumOf #-} @@ -871,14 +873,14 @@ -- @ -- -- @--- 'msumOf' :: 'MonadPlus' m => 'Getter' s a     -> s -> m a--- 'msumOf' :: 'MonadPlus' m => 'Fold' s a       -> s -> m a--- 'msumOf' :: 'MonadPlus' m => 'Lens'' s a      -> s -> m a--- 'msumOf' :: 'MonadPlus' m => 'Iso'' s a       -> s -> m a--- 'msumOf' :: 'MonadPlus' m => 'Traversal'' s a -> s -> m a--- 'msumOf' :: 'MonadPlus' m => 'Prism'' s a     -> s -> m a+-- 'msumOf' :: 'MonadPlus' m => 'Getter' s (m a)     -> s -> m a+-- 'msumOf' :: 'MonadPlus' m => 'Fold' s (m a)       -> s -> m a+-- 'msumOf' :: 'MonadPlus' m => 'Lens'' s (m a)      -> s -> m a+-- 'msumOf' :: 'MonadPlus' m => 'Iso'' s (m a)       -> s -> m a+-- 'msumOf' :: 'MonadPlus' m => 'Traversal'' s (m a) -> s -> m a+-- 'msumOf' :: 'MonadPlus' m => 'Prism'' s (m a)     -> s -> m a -- @-msumOf :: MonadPlus m => Getting (Endo (m a)) s t (m a) b -> s -> m a+msumOf :: MonadPlus m => Getting (Endo (m a)) s (m a) -> s -> m a msumOf l = foldrOf l mplus mzero {-# INLINE msumOf #-} @@ -899,7 +901,7 @@ -- 'elemOf' :: 'Eq' a => 'Traversal'' s a -> a -> s -> 'Bool' -- 'elemOf' :: 'Eq' a => 'Prism'' s a     -> a -> s -> 'Bool' -- @-elemOf :: Eq a => Getting Any s t a b -> a -> s -> Bool+elemOf :: Eq a => Getting Any s a -> a -> s -> Bool elemOf l = anyOf l . (==) {-# INLINE elemOf #-} @@ -923,7 +925,7 @@ -- 'notElemOf' :: 'Eq' a => 'Traversal'' s a -> a -> s -> 'Bool' -- 'notElemOf' :: 'Eq' a => 'Prism'' s a     -> a -> s -> 'Bool' -- @-notElemOf :: Eq a => Getting All s t a b -> a -> s -> Bool+notElemOf :: Eq a => Getting All s a -> a -> s -> Bool notElemOf l = allOf l . (/=) {-# INLINE notElemOf #-} @@ -943,7 +945,7 @@ -- 'concatMapOf' :: 'Iso'' s a       -> (a -> [r]) -> s -> [r] -- 'concatMapOf' :: 'Traversal'' s a -> (a -> [r]) -> s -> [r] -- @-concatMapOf :: Profunctor p => Accessing p [r] s t a b -> p a [r] -> s -> [r]+concatMapOf :: Profunctor p => Accessing p [r] s a -> p a [r] -> s -> [r] concatMapOf l ces = runAccessor #. l (Accessor #. ces) {-# INLINE concatMapOf #-} @@ -964,10 +966,11 @@ -- 'concatOf' :: 'Lens'' s [r]      -> s -> [r] -- 'concatOf' :: 'Traversal'' s [r] -> s -> [r] -- @-concatOf :: Getting [r] s t [r] b -> s -> [r]+concatOf :: Getting [r] s [r] -> s -> [r] concatOf l = runAccessor #. l Accessor {-# INLINE concatOf #-} + -- | Calculate the number of targets there are for a 'Fold' in a given container. -- -- /Note:/ This can be rather inefficient for large containers and just like 'length',@@ -987,7 +990,7 @@ -- 6 -- -- @--- 'lengthOf' ('folded' '.' 'folded') :: 'Foldable' f => f (g a) -> 'Int'+-- 'lengthOf' ('folded' '.' 'folded') :: ('Foldable' f, 'Foldable' g) => f (g a) -> 'Int' -- @ -- -- @@@ -997,7 +1000,7 @@ -- 'lengthOf' :: 'Iso'' s a       -> s -> 'Int' -- 'lengthOf' :: 'Traversal'' s a -> s -> 'Int' -- @-lengthOf :: Getting (Endo (Endo Int)) s t a b -> s -> Int+lengthOf :: Getting (Endo (Endo Int)) s a -> s -> Int lengthOf l = foldlOf' l (\a _ -> a + 1) 0 {-# INLINE lengthOf #-} @@ -1033,7 +1036,7 @@ -- ('^?') :: s -> 'Iso'' s a       -> 'Maybe' a -- ('^?') :: s -> 'Traversal'' s a -> 'Maybe' a -- @-(^?) :: s -> Getting (First a) s t a b -> Maybe a+(^?) :: s -> Getting (First a) s a -> Maybe a s ^? l = getFirst (foldMapOf l (First #. Just) s) {-# INLINE (^?) #-} @@ -1052,7 +1055,7 @@ -- ('^?!') :: s -> 'Iso'' s a       -> a -- ('^?!') :: s -> 'Traversal'' s a -> a -- @-(^?!) :: s -> Getting (Endo a) s t a b -> a+(^?!) :: s -> Getting (Endo a) s a -> a s ^?! l = foldrOf l const (error "(^?!): empty Fold") s {-# INLINE (^?!) #-} @@ -1079,7 +1082,7 @@ -- 'firstOf' :: 'Iso'' s a       -> s -> 'Maybe' a -- 'firstOf' :: 'Traversal'' s a -> s -> 'Maybe' a -- @-firstOf :: Getting (Leftmost a) s t a b -> s -> Maybe a+firstOf :: Getting (Leftmost a) s a -> s -> Maybe a firstOf l = getLeftmost . foldMapOf l LLeaf {-# INLINE firstOf #-} @@ -1106,7 +1109,7 @@ -- 'lastOf' :: 'Iso'' s a       -> s -> 'Maybe' a -- 'lastOf' :: 'Traversal'' s a -> s -> 'Maybe' a -- @-lastOf :: Getting (Rightmost a) s t a b -> s -> Maybe a+lastOf :: Getting (Rightmost a) s a -> s -> Maybe a lastOf l = getRightmost . foldMapOf l RLeaf {-# INLINE lastOf #-} @@ -1133,7 +1136,7 @@ -- True -- -- @--- 'nullOf' ('folded' '.' '_1' '.' 'folded') :: 'Foldable' f => f (g a, b) -> 'Bool'+-- 'nullOf' ('folded' '.' '_1' '.' 'folded') :: ('Foldable' f, 'Foldable' g) => f (g a, b) -> 'Bool' -- @ -- -- @@@ -1143,11 +1146,10 @@ -- 'nullOf' :: 'Lens'' s a      -> s -> 'Bool' -- 'nullOf' :: 'Traversal'' s a -> s -> 'Bool' -- @-nullOf :: Getting All s t a b -> s -> Bool-nullOf l = getAll #. foldMapOf l (\_ -> All False)+nullOf :: Getting All s a -> s -> Bool+nullOf = hasn't {-# INLINE nullOf #-} - -- | Returns 'True' if this 'Fold' or 'Traversal' has any targets in the given container. -- -- A more \"conversational\" alias for this combinator is 'has'.@@ -1173,7 +1175,7 @@ -- False -- -- @--- 'notNullOf' ('folded' '.' '_1' '.' 'folded') :: 'Foldable' f => f (g a, b) -> 'Bool'+-- 'notNullOf' ('folded' '.' '_1' '.' 'folded') :: ('Foldable' f, 'Foldable' g) => f (g a, b) -> 'Bool' -- @ -- -- @@@ -1183,8 +1185,8 @@ -- 'notNullOf' :: 'Lens'' s a      -> s -> 'Bool' -- 'notNullOf' :: 'Traversal'' s a -> s -> 'Bool' -- @-notNullOf :: Getting Any s t a b -> s -> Bool-notNullOf l = getAny #. foldMapOf l (\_ -> Any True)+notNullOf :: Getting Any s a -> s -> Bool+notNullOf = has {-# INLINE notNullOf #-}  -- | Obtain the maximum element (if any) targeted by a 'Fold' or 'Traversal' safely.@@ -1214,11 +1216,10 @@ -- 'maximumOf' :: 'Ord' a => 'Lens'' s a      -> s -> 'Maybe' a -- 'maximumOf' :: 'Ord' a => 'Traversal'' s a -> s -> 'Maybe' a -- @-maximumOf :: Ord a => Getting (Endo (Endo (Maybe a))) s t a b -> s -> Maybe a+maximumOf :: Ord a => Getting (Endo (Endo (Maybe a))) s a -> s -> Maybe a maximumOf l = foldlOf' l mf Nothing where   mf Nothing y = Just $! y   mf (Just x) y = Just $! max x y- {-# INLINE maximumOf #-}  -- | Obtain the minimum element (if any) targeted by a 'Fold' or 'Traversal' safely.@@ -1249,14 +1250,10 @@ -- 'minimumOf' :: 'Ord' a => 'Lens'' s a      -> s -> 'Maybe' a -- 'minimumOf' :: 'Ord' a => 'Traversal'' s a -> s -> 'Maybe' a -- @--minimumOf :: Ord a => Getting (Endo (Endo (Maybe a))) s t a b -> s -> Maybe a+minimumOf :: Ord a => Getting (Endo (Endo (Maybe a))) s a -> s -> Maybe a minimumOf l = foldlOf' l mf Nothing where   mf Nothing y = Just $! y   mf (Just x) y = Just $! min x y---- minimumOf :: Getting (Min a) s t a b -> s -> Maybe a--- minimumOf l = getMin `rmap` foldMapOf l Min {-# INLINE minimumOf #-}  -- | Obtain the maximum element (if any) targeted by a 'Fold', 'Traversal', 'Lens', 'Iso',@@ -1278,7 +1275,7 @@ -- 'maximumByOf' :: 'Lens'' s a      -> (a -> a -> 'Ordering') -> s -> 'Maybe' a -- 'maximumByOf' :: 'Traversal'' s a -> (a -> a -> 'Ordering') -> s -> 'Maybe' a -- @-maximumByOf :: Getting (Endo (Endo (Maybe a))) s t a b -> (a -> a -> Ordering) -> s -> Maybe a+maximumByOf :: Getting (Endo (Endo (Maybe a))) s a -> (a -> a -> Ordering) -> s -> Maybe a maximumByOf l cmp = foldlOf' l mf Nothing where   mf Nothing y = Just $! y   mf (Just x) y = Just $! if cmp x y == GT then x else y@@ -1303,7 +1300,7 @@ -- 'minimumByOf' :: 'Lens'' s a      -> (a -> a -> 'Ordering') -> s -> 'Maybe' a -- 'minimumByOf' :: 'Traversal'' s a -> (a -> a -> 'Ordering') -> s -> 'Maybe' a -- @-minimumByOf :: Getting (Endo (Endo (Maybe a))) s t a b -> (a -> a -> Ordering) -> s -> Maybe a+minimumByOf :: Getting (Endo (Endo (Maybe a))) s a -> (a -> a -> Ordering) -> s -> Maybe a minimumByOf l cmp = foldlOf' l mf Nothing where   mf Nothing y = Just $! y   mf (Just x) y = Just $! if cmp x y == GT then y else x@@ -1335,10 +1332,10 @@ -- A simpler version that didn't permit indexing, would be: -- -- @--- 'findOf' :: 'Getting' ('Endo' ('Maybe' a)) s t a b -> (a -> 'Bool') -> s -> 'Maybe' a+-- 'findOf' :: 'Getting' ('Endo' ('Maybe' a)) s a -> (a -> 'Bool') -> s -> 'Maybe' a -- 'findOf' l p = 'foldrOf' l (\a y -> if p a then 'Just' a else y) 'Nothing' -- @-findOf :: Conjoined p => Accessing p (Endo (Maybe a)) s t a b -> p a Bool -> s -> Maybe a+findOf :: Conjoined p => Accessing p (Endo (Maybe a)) s a -> p a Bool -> s -> Maybe a findOf l p = foldrOf l (cotabulate $ \wa y -> if corep p wa then Just (extract wa) else y) Nothing {-# INLINE findOf #-} @@ -1361,7 +1358,7 @@ -- 'foldr1Of' :: 'Lens'' s a      -> (a -> a -> a) -> s -> a -- 'foldr1Of' :: 'Traversal'' s a -> (a -> a -> a) -> s -> a -- @-foldr1Of :: Getting (Endo (Maybe a)) s t a b -> (a -> a -> a) -> s -> a+foldr1Of :: Getting (Endo (Maybe a)) s a -> (a -> a -> a) -> s -> a foldr1Of l f xs = fromMaybe (error "foldr1Of: empty structure")                             (foldrOf l mf Nothing xs) where   mf x my = Just $ case my of@@ -1387,7 +1384,7 @@ -- 'foldl1Of' :: 'Lens'' s a      -> (a -> a -> a) -> s -> a -- 'foldl1Of' :: 'Traversal'' s a -> (a -> a -> a) -> s -> a -- @-foldl1Of :: Getting (Dual (Endo (Maybe a))) s t a b -> (a -> a -> a) -> s -> a+foldl1Of :: Getting (Dual (Endo (Maybe a))) s a -> (a -> a -> a) -> s -> a foldl1Of l f xs = fromMaybe (error "foldl1Of: empty structure") (foldlOf l mf Nothing xs) where   mf mx y = Just $ case mx of     Nothing -> y@@ -1407,7 +1404,7 @@ -- 'foldrOf'' :: 'Lens'' s a      -> (a -> r -> r) -> r -> s -> r -- 'foldrOf'' :: 'Traversal'' s a -> (a -> r -> r) -> r -> s -> r -- @-foldrOf' :: Getting (Dual (Endo (Endo r))) s t a b -> (a -> r -> r) -> r -> s -> r+foldrOf' :: Getting (Dual (Endo (Endo r))) s a -> (a -> r -> r) -> r -> s -> r foldrOf' l f z0 xs = foldlOf l f' (Endo id) xs `appEndo` z0   where f' (Endo k) x = Endo $ \ z -> k $! f x z {-# INLINE foldrOf' #-}@@ -1425,7 +1422,7 @@ -- 'foldlOf'' :: 'Lens'' s a      -> (r -> a -> r) -> r -> s -> r -- 'foldlOf'' :: 'Traversal'' s a -> (r -> a -> r) -> r -> s -> r -- @-foldlOf' :: Getting (Endo (Endo r)) s t a b -> (r -> a -> r) -> r -> s -> r+foldlOf' :: Getting (Endo (Endo r)) s a -> (r -> a -> r) -> r -> s -> r foldlOf' l f z0 xs = foldrOf l f' (Endo id) xs `appEndo` z0   where f' x (Endo k) = Endo $ \z -> k $! f z x {-# INLINE foldlOf' #-}@@ -1445,7 +1442,7 @@ -- 'foldr1Of'' :: 'Lens'' s a      -> (a -> a -> a) -> s -> a -- 'foldr1Of'' :: 'Traversal'' s a -> (a -> a -> a) -> s -> a -- @-foldr1Of' :: Getting (Dual (Endo (Endo (Maybe a)))) s t a b -> (a -> a -> a) -> s -> a+foldr1Of' :: Getting (Dual (Endo (Endo (Maybe a)))) s a -> (a -> a -> a) -> s -> a foldr1Of' l f xs = fromMaybe (error "foldr1Of': empty structure") (foldrOf' l mf Nothing xs) where   mf x Nothing = Just $! x   mf x (Just y) = Just $! f x y@@ -1466,7 +1463,7 @@ -- 'foldl1Of'' :: 'Lens'' s a      -> (a -> a -> a) -> s -> a -- 'foldl1Of'' :: 'Traversal'' s a -> (a -> a -> a) -> s -> a -- @-foldl1Of' :: Getting (Endo (Endo (Maybe a))) s t a b -> (a -> a -> a) -> s -> a+foldl1Of' :: Getting (Endo (Endo (Maybe a))) s a -> (a -> a -> a) -> s -> a foldl1Of' l f xs = fromMaybe (error "foldl1Of': empty structure") (foldlOf' l mf Nothing xs) where   mf Nothing y = Just $! y   mf (Just x) y = Just $! f x y@@ -1487,7 +1484,7 @@ -- 'foldrMOf' :: 'Monad' m => 'Traversal'' s a -> (a -> r -> m r) -> r -> s -> m r -- @ foldrMOf :: Monad m-         => Getting (Dual (Endo (r -> m r))) s t a b+         => Getting (Dual (Endo (r -> m r))) s a          -> (a -> r -> m r) -> r -> s -> m r foldrMOf l f z0 xs = foldlOf l f' return xs z0   where f' k x z = f x z >>= k@@ -1508,7 +1505,7 @@ -- 'foldlMOf' :: 'Monad' m => 'Traversal'' s a -> (r -> a -> m r) -> r -> s -> m r -- @ foldlMOf :: Monad m-         => Getting (Endo (r -> m r)) s t a b+         => Getting (Endo (r -> m r)) s a          -> (r -> a -> m r) -> r -> s -> m r foldlMOf l f z0 xs = foldrOf l f' return xs z0   where f' x k z = f z x >>= k@@ -1537,10 +1534,12 @@ -- 'has' :: 'Lens'' s a      -> s -> 'Bool' -- 'has' :: 'Traversal'' s a -> s -> 'Bool' -- @-has :: Getting Any s t a b -> s -> Bool+has :: Getting Any s a -> s -> Bool has l = getAny #. foldMapOf l (\_ -> Any True) {-# INLINE has #-} ++ -- | Check to see if this 'Fold' or 'Traversal' has no matches. -- -- >>> hasn't _Left (Right 12)@@ -1548,7 +1547,7 @@ -- -- >>> hasn't _Left (Left 12) -- False-hasn't :: Getting All s t a b -> s -> Bool+hasn't :: Getting All s a -> s -> Bool hasn't l = getAll #. foldMapOf l (\_ -> All False) {-# INLINE hasn't #-} @@ -1556,32 +1555,33 @@ -- Pre ------------------------------------------------------------------------------ --- | This converts a 'Fold' to a 'IndexPreservingGetter' that returns the first element if it--- exists as a 'Maybe'.+-- | This converts a 'Fold' to a 'IndexPreservingGetter' that returns the first element, if it+-- exists, as a 'Maybe'. -- -- @--- 'pre' :: 'Getter' s a        -> 'IndexPreservingGetter' s ('Maybe' a)--- 'pre' :: 'Fold' s a          -> 'IndexPreservingGetter' s ('Maybe' a)--- 'pre' :: 'Traversal' s t a b -> 'IndexPreservingGetter' s ('Maybe' a)--- 'pre' :: 'Lens' s t a b      -> 'IndexPreservingGetter' s ('Maybe' a)--- 'pre' :: 'Iso' s t a b       -> 'IndexPreservingGetter' s ('Maybe' a)--- 'pre' :: 'Prism' s t a b     -> 'IndexPreservingGetter' s ('Maybe' a)+-- 'pre' :: 'Getter' s a           -> 'IndexPreservingGetter' s ('Maybe' a)+-- 'pre' :: 'Fold' s a             -> 'IndexPreservingGetter' s ('Maybe' a)+-- 'pre' :: 'Simple' 'Traversal' s a -> 'IndexPreservingGetter' s ('Maybe' a)+-- 'pre' :: 'Simple' 'Lens' s a      -> 'IndexPreservingGetter' s ('Maybe' a)+-- 'pre' :: 'Simple' 'Iso' s a       -> 'IndexPreservingGetter' s ('Maybe' a)+-- 'pre' :: 'Simple' 'Prism' s a     -> 'IndexPreservingGetter' s ('Maybe' a) -- @-pre :: Getting (First a) s t a b -> IndexPreservingGetter s (Maybe a)+pre :: Getting (First a) s a -> IndexPreservingGetter s (Maybe a) pre l = dimap (getFirst . runAccessor #. l (Accessor #. First #. Just)) coerce-+{-# INLINE pre #-}  -- | This converts an 'IndexedFold' to an 'IndexPreservingGetter' that returns the first index--- and element if it exists as a 'Maybe'.+-- and element, if they exist, as a 'Maybe'. -- -- @--- 'ipre' :: 'IndexedGetter' i s a        -> 'IndexPreservingGetter' s ('Maybe' (i, a))--- 'ipre' :: 'IndexedFold' i s a          -> 'IndexPreservingGetter' s ('Maybe' (i, a))--- 'ipre' :: 'IndexedTraversal' i s t a b -> 'IndexPreservingGetter' s ('Maybe' (i, a))--- 'ipre' :: 'IndexedLens' i s t a b      -> 'IndexPreservingGetter' s ('Maybe' (i, a))+-- 'ipre' :: 'IndexedGetter' i s a             -> 'IndexPreservingGetter' s ('Maybe' (i, a))+-- 'ipre' :: 'IndexedFold' i s a               -> 'IndexPreservingGetter' s ('Maybe' (i, a))+-- 'ipre' :: 'Simple' ('IndexedTraversal' i) s a -> 'IndexPreservingGetter' s ('Maybe' (i, a))+-- 'ipre' :: 'Simple' ('IndexedLens' i) s a      -> 'IndexPreservingGetter' s ('Maybe' (i, a)) -- @-ipre :: IndexedGetting i (First (i, a)) s t a b -> IndexPreservingGetter s (Maybe (i, a))+ipre :: IndexedGetting i (First (i, a)) s a -> IndexPreservingGetter s (Maybe (i, a)) ipre l = dimap (getFirst . runAccessor #. l (Indexed $ \i a -> Accessor (First (Just (i, a))))) coerce+{-# INLINE ipre #-}  ------------------------------------------------------------------------------ -- Preview@@ -1619,7 +1619,7 @@ -- 'preview' :: 'MonadReader' s m => 'Iso'' s a       -> m ('Maybe' a) -- 'preview' :: 'MonadReader' s m => 'Traversal'' s a -> m ('Maybe' a) -- @-preview :: MonadReader s m => Getting (First a) s t a b -> m (Maybe a)+preview :: MonadReader s m => Getting (First a) s a -> m (Maybe a) preview l = asks (getFirst #. foldMapOf l (First #. Just)) {-# INLINE preview #-} @@ -1649,7 +1649,7 @@ -- 'ipreview' :: 'MonadReader' s m => 'IndexedLens'' s a      -> m ('Maybe' (i, a)) -- 'ipreview' :: 'MonadReader' s m => 'IndexedTraversal'' s a -> m ('Maybe' (i, a)) -- @-ipreview :: MonadReader s m => IndexedGetting i (First (i, a)) s t a b -> m (Maybe (i, a))+ipreview :: MonadReader s m => IndexedGetting i (First (i, a)) s a -> m (Maybe (i, a)) ipreview l = asks (getFirst #. ifoldMapOf l (\i a -> First (Just (i, a)))) {-# INLINE ipreview #-} @@ -1681,7 +1681,7 @@ -- 'previews' :: 'MonadReader' s m => 'Iso'' s a       -> (a -> r) -> m ('Maybe' r) -- 'previews' :: 'MonadReader' s m => 'Traversal'' s a -> (a -> r) -> m ('Maybe' r) -- @-previews :: MonadReader s m => Getting (First r) s t a b -> (a -> r) -> m (Maybe r)+previews :: MonadReader s m => Getting (First r) s a -> (a -> r) -> m (Maybe r) previews l f = asks (getFirst . foldMapOf l (First #. Just . f)) {-# INLINE previews #-} @@ -1707,12 +1707,12 @@ -- a 'Control.Monad.Monad' transformer stack: -- -- @--- 'ipreviews' :: 'MonadReader' s m => 'IndexedGetter' s a     -> (i -> a -> r) -> m ('Maybe' r)--- 'ipreviews' :: 'MonadReader' s m => 'IndexedFold' s a       -> (i -> a -> r) -> m ('Maybe' r)--- 'ipreviews' :: 'MonadReader' s m => 'IndexedLens'' s a      -> (i -> a -> r) -> m ('Maybe' r)--- 'ipreviews' :: 'MonadReader' s m => 'IndexedTraversal'' s a -> (i -> a -> r) -> m ('Maybe' r)+-- 'ipreviews' :: 'MonadReader' s m => 'IndexedGetter' i s a     -> (i -> a -> r) -> m ('Maybe' r)+-- 'ipreviews' :: 'MonadReader' s m => 'IndexedFold' i s a       -> (i -> a -> r) -> m ('Maybe' r)+-- 'ipreviews' :: 'MonadReader' s m => 'IndexedLens'' i s a      -> (i -> a -> r) -> m ('Maybe' r)+-- 'ipreviews' :: 'MonadReader' s m => 'IndexedTraversal'' i s a -> (i -> a -> r) -> m ('Maybe' r) -- @-ipreviews :: MonadReader s m => IndexedGetting i (First r) s t a b -> (i -> a -> r) -> m (Maybe r)+ipreviews :: MonadReader s m => IndexedGetting i (First r) s a -> (i -> a -> r) -> m (Maybe r) ipreviews l f = asks (getFirst . ifoldMapOf l (\i -> First #. Just . f i)) {-# INLINE ipreviews #-} @@ -1734,7 +1734,7 @@ -- 'preuse' :: 'MonadState' s m => 'Iso'' s a       -> m ('Maybe' a) -- 'preuse' :: 'MonadState' s m => 'Traversal'' s a -> m ('Maybe' a) -- @-preuse :: MonadState s m => Getting (First a) s t a b -> m (Maybe a)+preuse :: MonadState s m => Getting (First a) s a -> m (Maybe a) preuse l = gets (preview l) {-# INLINE preuse #-} @@ -1751,7 +1751,7 @@ -- 'ipreuse' :: 'MonadState' s m => 'IndexedLens'' i s a      -> m ('Maybe' (i, a)) -- 'ipreuse' :: 'MonadState' s m => 'IndexedTraversal'' i s a -> m ('Maybe' (i, a)) -- @-ipreuse :: MonadState s m => IndexedGetting i (First (i, a)) s t a b -> m (Maybe (i, a))+ipreuse :: MonadState s m => IndexedGetting i (First (i, a)) s a -> m (Maybe (i, a)) ipreuse l = gets (ipreview l) {-# INLINE ipreuse #-} @@ -1769,7 +1769,7 @@ -- 'preuses' :: 'MonadState' s m => 'Iso'' s a       -> (a -> r) -> m ('Maybe' r) -- 'preuses' :: 'MonadState' s m => 'Traversal'' s a -> (a -> r) -> m ('Maybe' r) -- @-preuses :: MonadState s m => Getting (First r) s t a b -> (a -> r) -> m (Maybe r)+preuses :: MonadState s m => Getting (First r) s a -> (a -> r) -> m (Maybe r) preuses l f = gets (previews l f) {-# INLINE preuses #-} @@ -1787,7 +1787,7 @@ -- 'ipreuses' :: 'MonadState' s m => 'IndexedLens'' i s a      -> (i -> a -> r) -> m ('Maybe' r) -- 'ipreuses' :: 'MonadState' s m => 'IndexedTraversal'' i s a -> (i -> a -> r) -> m ('Maybe' r) -- @-ipreuses :: MonadState s m => IndexedGetting i (First r) s t a b -> (i -> a -> r) -> m (Maybe r)+ipreuses :: MonadState s m => IndexedGetting i (First r) s a -> (i -> a -> r) -> m (Maybe r) ipreuses l f = gets (ipreviews l f) {-# INLINE ipreuses #-} @@ -1828,7 +1828,7 @@ -- 'ifoldMapOf' :: 'Monoid' m => 'IndexedTraversal'' i s a -> (i -> a -> m) -> s -> m -- @ ---ifoldMapOf :: IndexedGetting i m s t a b -> (i -> a -> m) -> s -> m+ifoldMapOf :: IndexedGetting i m s a -> (i -> a -> m) -> s -> m ifoldMapOf l = foldMapOf l .# Indexed {-# INLINE ifoldMapOf #-} @@ -1847,7 +1847,7 @@ -- 'ifoldrOf' :: 'IndexedLens'' i s a      -> (i -> a -> r -> r) -> r -> s -> r -- 'ifoldrOf' :: 'IndexedTraversal'' i s a -> (i -> a -> r -> r) -> r -> s -> r -- @-ifoldrOf :: IndexedGetting i (Endo r) s t a b -> (i -> a -> r -> r) -> r -> s -> r+ifoldrOf :: IndexedGetting i (Endo r) s a -> (i -> a -> r -> r) -> r -> s -> r ifoldrOf l = foldrOf l .# Indexed {-# INLINE ifoldrOf #-} @@ -1866,7 +1866,7 @@ -- 'ifoldlOf' :: 'IndexedLens'' i s a      -> (i -> r -> a -> r) -> r -> s -> r -- 'ifoldlOf' :: 'IndexedTraversal'' i s a -> (i -> r -> a -> r) -> r -> s -> r -- @-ifoldlOf :: IndexedGetting i (Dual (Endo r)) s t a b -> (i -> r -> a -> r) -> r -> s -> r+ifoldlOf :: IndexedGetting i (Dual (Endo r)) s a -> (i -> r -> a -> r) -> r -> s -> r ifoldlOf l f z = (flip appEndo z .# getDual) `rmap` ifoldMapOf l (\i -> Dual #. Endo #. flip (f i)) {-# INLINE ifoldlOf #-} @@ -1885,7 +1885,7 @@ -- 'ianyOf' :: 'IndexedLens'' i s a      -> (i -> a -> 'Bool') -> s -> 'Bool' -- 'ianyOf' :: 'IndexedTraversal'' i s a -> (i -> a -> 'Bool') -> s -> 'Bool' -- @-ianyOf :: IndexedGetting i Any s t a b -> (i -> a -> Bool) -> s -> Bool+ianyOf :: IndexedGetting i Any s a -> (i -> a -> Bool) -> s -> Bool ianyOf l = anyOf l .# Indexed {-# INLINE ianyOf #-} @@ -1904,7 +1904,7 @@ -- 'iallOf' :: 'IndexedLens'' i s a      -> (i -> a -> 'Bool') -> s -> 'Bool' -- 'iallOf' :: 'IndexedTraversal'' i s a -> (i -> a -> 'Bool') -> s -> 'Bool' -- @-iallOf :: IndexedGetting i All s t a b -> (i -> a -> Bool) -> s -> Bool+iallOf :: IndexedGetting i All s a -> (i -> a -> Bool) -> s -> Bool iallOf l = allOf l .# Indexed {-# INLINE iallOf #-} @@ -1922,7 +1922,7 @@ -- 'itraverseOf_' :: 'Functor' f     => 'IndexedLens'' i s a      -> (i -> a -> f r) -> s -> f () -- 'itraverseOf_' :: 'Applicative' f => 'IndexedTraversal'' i s a -> (i -> a -> f r) -> s -> f () -- @-itraverseOf_ :: Functor f => IndexedGetting i (Traversed r f) s t a b -> (i -> a -> f r) -> s -> f ()+itraverseOf_ :: Functor f => IndexedGetting i (Traversed r f) s a -> (i -> a -> f r) -> s -> f () itraverseOf_ l = traverseOf_ l .# Indexed {-# INLINE itraverseOf_ #-} @@ -1945,7 +1945,7 @@ -- 'iforOf_' :: 'Functor' f     => 'IndexedLens'' i s a      -> s -> (i -> a -> f r) -> f () -- 'iforOf_' :: 'Applicative' f => 'IndexedTraversal'' i s a -> s -> (i -> a -> f r) -> f () -- @-iforOf_ :: Functor f => IndexedGetting i (Traversed r f) s t a b -> s -> (i -> a -> f r) -> f ()+iforOf_ :: Functor f => IndexedGetting i (Traversed r f) s a -> s -> (i -> a -> f r) -> f () iforOf_ = flip . itraverseOf_ {-# INLINE iforOf_ #-} @@ -1964,7 +1964,7 @@ -- 'imapMOf_' :: 'Monad' m => 'IndexedLens'' i s a      -> (i -> a -> m r) -> s -> m () -- 'imapMOf_' :: 'Monad' m => 'IndexedTraversal'' i s a -> (i -> a -> m r) -> s -> m () -- @-imapMOf_ :: Monad m => IndexedGetting i (Sequenced r m) s t a b -> (i -> a -> m r) -> s -> m ()+imapMOf_ :: Monad m => IndexedGetting i (Sequenced r m) s a -> (i -> a -> m r) -> s -> m () imapMOf_ l = mapMOf_ l .# Indexed {-# INLINE imapMOf_ #-} @@ -1987,7 +1987,7 @@ -- 'iforMOf_' :: 'Monad' m => 'IndexedLens'' i s a      -> s -> (i -> a -> m r) -> m () -- 'iforMOf_' :: 'Monad' m => 'IndexedTraversal'' i s a -> s -> (i -> a -> m r) -> m () -- @-iforMOf_ :: Monad m => IndexedGetting i (Sequenced r m) s t a b -> s -> (i -> a -> m r) -> m ()+iforMOf_ :: Monad m => IndexedGetting i (Sequenced r m) s a -> s -> (i -> a -> m r) -> m () iforMOf_ = flip . imapMOf_ {-# INLINE iforMOf_ #-} @@ -2007,7 +2007,7 @@ -- 'iconcatMapOf' :: 'IndexedLens'' i s a      -> (i -> a -> [r]) -> s -> [r] -- 'iconcatMapOf' :: 'IndexedTraversal'' i s a -> (i -> a -> [r]) -> s -> [r] -- @-iconcatMapOf :: IndexedGetting i [r] s t a b -> (i -> a -> [r]) -> s -> [r]+iconcatMapOf :: IndexedGetting i [r] s a -> (i -> a -> [r]) -> s -> [r] iconcatMapOf = ifoldMapOf {-# INLINE iconcatMapOf #-} @@ -2022,12 +2022,12 @@ -- @ -- -- @--- 'ifindOf' :: 'IndexedGetter' s a     -> (i -> a -> 'Bool') -> s -> 'Maybe' a--- 'ifindOf' :: 'IndexedFold' s a       -> (i -> a -> 'Bool') -> s -> 'Maybe' a--- 'ifindOf' :: 'IndexedLens'' s a      -> (i -> a -> 'Bool') -> s -> 'Maybe' a--- 'ifindOf' :: 'IndexedTraversal'' s a -> (i -> a -> 'Bool') -> s -> 'Maybe' a+-- 'ifindOf' :: 'IndexedGetter' i s a     -> (i -> a -> 'Bool') -> s -> 'Maybe' a+-- 'ifindOf' :: 'IndexedFold' i s a       -> (i -> a -> 'Bool') -> s -> 'Maybe' a+-- 'ifindOf' :: 'IndexedLens'' i s a      -> (i -> a -> 'Bool') -> s -> 'Maybe' a+-- 'ifindOf' :: 'IndexedTraversal'' i s a -> (i -> a -> 'Bool') -> s -> 'Maybe' a -- @-ifindOf :: IndexedGetting i (Endo (Maybe a)) s t a b -> (i -> a -> Bool) -> s -> Maybe a+ifindOf :: IndexedGetting i (Endo (Maybe a)) s a -> (i -> a -> Bool) -> s -> Maybe a ifindOf l = findOf l .# Indexed {-# INLINE ifindOf #-} @@ -2045,7 +2045,7 @@ -- 'ifoldrOf'' :: 'IndexedLens'' i s a      -> (i -> a -> r -> r) -> r -> s -> r -- 'ifoldrOf'' :: 'IndexedTraversal'' i s a -> (i -> a -> r -> r) -> r -> s -> r -- @-ifoldrOf' :: IndexedGetting i (Dual (Endo (r -> r))) s t a b -> (i -> a -> r -> r) -> r -> s -> r+ifoldrOf' :: IndexedGetting i (Dual (Endo (r -> r))) s a -> (i -> a -> r -> r) -> r -> s -> r ifoldrOf' l f z0 xs = ifoldlOf l f' id xs z0   where f' i k x z = k $! f i x z {-# INLINE ifoldrOf' #-}@@ -2064,7 +2064,7 @@ -- 'ifoldlOf'' :: 'IndexedLens'' i s a        -> (i -> r -> a -> r) -> r -> s -> r -- 'ifoldlOf'' :: 'IndexedTraversal'' i s a   -> (i -> r -> a -> r) -> r -> s -> r -- @-ifoldlOf' :: IndexedGetting i (Endo (r -> r)) s t a b -> (i -> r -> a -> r) -> r -> s -> r+ifoldlOf' :: IndexedGetting i (Endo (r -> r)) s a -> (i -> r -> a -> r) -> r -> s -> r ifoldlOf' l f z0 xs = ifoldrOf l f' id xs z0   where f' i x k z = k $! f i z x {-# INLINE ifoldlOf' #-}@@ -2078,12 +2078,12 @@ -- @ -- -- @--- 'ifoldrMOf' :: 'Monad' m => 'IndexedGetter' i s a     -> (i -> a -> r -> m r) -> r -> s -> r--- 'ifoldrMOf' :: 'Monad' m => 'IndexedFold' i s a       -> (i -> a -> r -> m r) -> r -> s -> r--- 'ifoldrMOf' :: 'Monad' m => 'IndexedLens'' i s a      -> (i -> a -> r -> m r) -> r -> s -> r--- 'ifoldrMOf' :: 'Monad' m => 'IndexedTraversal'' i s a -> (i -> a -> r -> m r) -> r -> s -> r+-- 'ifoldrMOf' :: 'Monad' m => 'IndexedGetter' i s a     -> (i -> a -> r -> m r) -> r -> s -> m r+-- 'ifoldrMOf' :: 'Monad' m => 'IndexedFold' i s a       -> (i -> a -> r -> m r) -> r -> s -> m r+-- 'ifoldrMOf' :: 'Monad' m => 'IndexedLens'' i s a      -> (i -> a -> r -> m r) -> r -> s -> m r+-- 'ifoldrMOf' :: 'Monad' m => 'IndexedTraversal'' i s a -> (i -> a -> r -> m r) -> r -> s -> m r -- @-ifoldrMOf :: Monad m => IndexedGetting i (Dual (Endo (r -> m r))) s t a b -> (i -> a -> r -> m r) -> r -> s -> m r+ifoldrMOf :: Monad m => IndexedGetting i (Dual (Endo (r -> m r))) s a -> (i -> a -> r -> m r) -> r -> s -> m r ifoldrMOf l f z0 xs = ifoldlOf l f' return xs z0   where f' i k x z = f i x z >>= k {-# INLINE ifoldrMOf #-}@@ -2097,12 +2097,12 @@ -- @ -- -- @--- 'ifoldlOf'' :: 'Monad' m => 'IndexedGetter' i s a     -> (i -> r -> a -> m r) -> r -> s -> r--- 'ifoldlOf'' :: 'Monad' m => 'IndexedFold' i s a       -> (i -> r -> a -> m r) -> r -> s -> r--- 'ifoldlOf'' :: 'Monad' m => 'IndexedLens'' i s a      -> (i -> r -> a -> m r) -> r -> s -> r--- 'ifoldlOf'' :: 'Monad' m => 'IndexedTraversal'' i s a -> (i -> r -> a -> m r) -> r -> s -> r+-- 'ifoldlMOf' :: 'Monad' m => 'IndexedGetter' i s a     -> (i -> r -> a -> m r) -> r -> s -> m r+-- 'ifoldlMOf' :: 'Monad' m => 'IndexedFold' i s a       -> (i -> r -> a -> m r) -> r -> s -> m r+-- 'ifoldlMOf' :: 'Monad' m => 'IndexedLens'' i s a      -> (i -> r -> a -> m r) -> r -> s -> m r+-- 'ifoldlMOf' :: 'Monad' m => 'IndexedTraversal'' i s a -> (i -> r -> a -> m r) -> r -> s -> m r -- @-ifoldlMOf :: Monad m => IndexedGetting i (Endo (r -> m r)) s t a b -> (i -> r -> a -> m r) -> r -> s -> m r+ifoldlMOf :: Monad m => IndexedGetting i (Endo (r -> m r)) s a -> (i -> r -> a -> m r) -> r -> s -> m r ifoldlMOf l f z0 xs = ifoldrOf l f' return xs z0   where f' i x k z = f i z x >>= k {-# INLINE ifoldlMOf #-}@@ -2121,7 +2121,7 @@ -- 'itoListOf' :: 'IndexedLens'' i s a      -> s -> [(i,a)] -- 'itoListOf' :: 'IndexedTraversal'' i s a -> s -> [(i,a)] -- @-itoListOf :: IndexedGetting i (Endo [(i,a)]) s t a b -> s -> [(i,a)]+itoListOf :: IndexedGetting i (Endo [(i,a)]) s a -> s -> [(i,a)] itoListOf l = ifoldrOf l (\i a -> ((i,a):)) [] {-# INLINE itoListOf #-} @@ -2133,8 +2133,9 @@ -- ('^@..') :: s -> 'IndexedLens'' i s a      -> [(i,a)] -- ('^@..') :: s -> 'IndexedTraversal'' i s a -> [(i,a)] -- @-(^@..) :: s -> IndexedGetting i (Endo [(i,a)]) s t a b -> [(i,a)]+(^@..) :: s -> IndexedGetting i (Endo [(i,a)]) s a -> [(i,a)] s ^@.. l = ifoldrOf l (\i a -> ((i,a):)) [] s+{-# INLINE (^@..) #-}  -- | Perform a safe 'head' (with index) of an 'IndexedFold' or 'IndexedTraversal' or retrieve 'Just' the index and result -- from an 'IndexedGetter' or 'IndexedLens'.@@ -2143,26 +2144,24 @@ -- way to extract the optional value. -- -- @--- ('^@?') :: s -> 'IndexedGetter' i s a -> 'Maybe' (i, a)--- ('^@?') :: s -> 'IndexedFold' i s a   -> 'Maybe' (i, a)--- ('^@?') :: s -> 'IndexedLens'' i s a  -> 'Maybe' (i, a)--- ('^@?') :: s -> 'Iso'' i s a          -> 'Maybe' (i, a)--- ('^@?') :: s -> 'Traversal'' i s a    -> 'Maybe' (i, a)+-- ('^@?') :: s -> 'IndexedGetter' i s a     -> 'Maybe' (i, a)+-- ('^@?') :: s -> 'IndexedFold' i s a       -> 'Maybe' (i, a)+-- ('^@?') :: s -> 'IndexedLens'' i s a      -> 'Maybe' (i, a)+-- ('^@?') :: s -> 'IndexedTraversal'' i s a -> 'Maybe' (i, a) -- @-(^@?) :: s -> IndexedGetting i (Endo (Maybe (i, a))) s t a b -> Maybe (i, a)+(^@?) :: s -> IndexedGetting i (Endo (Maybe (i, a))) s a -> Maybe (i, a) s ^@? l = ifoldrOf l (\i x _ -> Just (i,x)) Nothing s {-# INLINE (^@?) #-}  -- | Perform an *UNSAFE* 'head' (with index) of an 'IndexedFold' or 'IndexedTraversal' assuming that it is there. -- -- @--- ('^@?!') :: s -> 'IndexedGetter' i s a -> (i, a)--- ('^@?!') :: s -> 'IndexedFold' i s a   -> (i, a)--- ('^@?!') :: s -> 'Lens'' i s a         -> (i, a)--- ('^@?!') :: s -> 'Iso'' i s a          -> (i, a)--- ('^@?!') :: s -> 'Traversal'' i s a    -> (i, a)+-- ('^@?!') :: s -> 'IndexedGetter' i s a     -> (i, a)+-- ('^@?!') :: s -> 'IndexedFold' i s a       -> (i, a)+-- ('^@?!') :: s -> 'IndexedLens'' i s a      -> (i, a)+-- ('^@?!') :: s -> 'IndexedTraversal'' i s a -> (i, a) -- @-(^@?!) :: s -> IndexedGetting i (Endo (i, a)) s t a b -> (i, a)+(^@?!) :: s -> IndexedGetting i (Endo (i, a)) s a -> (i, a) s ^@?! l = ifoldrOf l (\i x _ -> (i,x)) (error "(^@?!): empty Fold") s {-# INLINE (^@?!) #-} @@ -2194,7 +2193,7 @@ -- 'itakingWhile' :: (i -> a -> 'Bool') -> 'IndexedMonadicFold' i m s a -> 'IndexedMonadicFold' i m s a -- 'itakingWhile' :: (i -> a -> 'Bool') -> 'IndexedAction' i m s a      -> 'IndexedMonadicFold' i m s a -- @-itakingWhile :: (Indexable i p, Profunctor q, Applicative f, Gettable f)+itakingWhile :: (Indexable i p, Profunctor q, Contravariant f, Applicative f)          => (i -> a -> Bool)          -> Overloading (Indexed i) q (Accessor (Endo (f s))) s s a a          -> Overloading p q f s s a a@@ -2231,10 +2230,10 @@ ------------------------------------------------------------------------------  -- | A deprecated alias for 'firstOf'.-headOf :: Getting (First a) s t a b -> s -> Maybe a+headOf :: Getting (First a) s a -> s -> Maybe a headOf l = getFirst #. foldMapOf l (First #. Just) {-# INLINE headOf #-}-{-# DEPRECATED headOf "`headOf' will be removed in 3.9. (Use `preview' or `firstOf')" #-}+{-# DEPRECATED headOf "`headOf' will be removed after GHC 7.8 is released. (Use `preview' or `firstOf')" #-}  ------------------------------------------------------------------------------ -- Misc.

@@ -5,6 +5,10 @@ #ifdef TRUSTWORTHY {-# LANGUAGE Trustworthy #-} #endif+#if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ >= 704+{-# LANGUAGE NoPolyKinds #-}+{-# LANGUAGE NoDataKinds #-}+#endif ------------------------------------------------------------------------------- -- | -- Module      :  Control.Lens.Getter@@ -50,8 +54,8 @@   , to   -- * Combinators for Getters and Folds   , (^.)-  , view, views, view', views'-  , use, uses, use', uses'+  , view, views+  , use, uses   , listening, listenings   -- * Indexed Getters   -- ** Indexed Getter Combinators@@ -60,8 +64,10 @@   , iuse, iuses   , ilistening, ilistenings   -- * Implementation Details-  , Gettable(..)+  , Contravariant(..)+  , coerce, coerced   , Accessor(..)+  , Gettable   ) where  import Control.Lens.Internal.Getter@@ -70,6 +76,7 @@ import Control.Monad.Reader.Class as Reader import Control.Monad.State        as State import Control.Monad.Writer       as Writer+import Data.Functor.Contravariant import Data.Profunctor import Data.Profunctor.Unsafe @@ -130,15 +137,14 @@ -- you can pass a 'Control.Lens.Fold.Fold' (or -- 'Control.Lens.Traversal.Traversal'), otherwise you can only pass this a -- 'Getter' or 'Lens'.----type Getting r s t a b = (a -> Accessor r b) -> s -> Accessor r t+type Getting r s a = (a -> Accessor r a) -> s -> Accessor r s  -- | Used to consume an 'Control.Lens.Fold.IndexedFold'.-type IndexedGetting i m s t a b = Indexed i a (Accessor m b) -> s -> Accessor m t+type IndexedGetting i m s a = Indexed i a (Accessor m a) -> s -> Accessor m s  -- | This is a convenient alias used when consuming (indexed) getters and (indexed) folds -- in a highly general fashion.-type Accessing p m s t a b = p a (Accessor m b) -> s -> Accessor m t+type Accessing p m s a = p a (Accessor m a) -> s -> Accessor m s  ------------------------------------------------------------------------------- -- Getting Values@@ -186,7 +192,7 @@ -- 'view' :: 'MonadReader' s m             => 'Lens'' s a      -> m a -- 'view' :: ('MonadReader' s m, 'Data.Monoid.Monoid' a) => 'Control.Lens.Traversal.Traversal'' s a -> m a -- @-view :: MonadReader s m => Getting a s t a b -> m a+view :: MonadReader s m => Getting a s a -> m a view l = Reader.asks (runAccessor #. l Accessor) {-# INLINE view #-} @@ -226,10 +232,10 @@ -- @ -- -- @--- 'views' :: 'MonadReader' s m => 'Getting' r s t a b -> (a -> r) -> m r+-- 'views' :: 'MonadReader' s m => 'Getting' r s a -> (a -> r) -> m r -- @-views :: (Profunctor p, MonadReader s m) => Overloading p (->) (Accessor r) s t a b -> p a r -> m r-views l f = Reader.asks (runAccessor #. l (rmap Accessor f))+views :: (Profunctor p, MonadReader s m) => Overloading p (->) (Accessor r) s s a a -> p a r -> m r+views l f = Reader.asks (runAccessor #. l (Accessor #. f)) {-# INLINE views #-}  -- | View the value pointed to by a 'Getter' or 'Lens' or the@@ -258,7 +264,7 @@ -- ('^.') ::             s -> 'Lens'' s a      -> a -- ('^.') :: 'Data.Monoid.Monoid' m => s -> 'Control.Lens.Traversal.Traversal'' s m -> m -- @-(^.) :: s -> Getting a s t a b -> a+(^.) :: s -> Getting a s a -> a s ^. l = runAccessor (l Accessor s) {-# INLINE (^.) #-} @@ -284,7 +290,7 @@ -- 'use' :: 'MonadState' s m             => 'Lens'' s a      -> m a -- 'use' :: ('MonadState' s m, 'Data.Monoid.Monoid' r) => 'Control.Lens.Traversal.Traversal'' s r -> m r -- @-use :: MonadState s m => Getting a s t a b -> m a+use :: MonadState s m => Getting a s a -> m a use l = State.gets (view l) {-# INLINE use #-} @@ -307,7 +313,7 @@ -- @ -- 'uses' :: 'MonadState' s m => 'Getting' r s t a b -> (a -> r) -> m r -- @-uses :: (Profunctor p, MonadState s m) => Overloading p (->) (Accessor r) s t a b -> p a r -> m r+uses :: (Profunctor p, MonadState s m) => Overloading p (->) (Accessor r) s s a a -> p a r -> m r uses l f = State.gets (views l f) {-# INLINE uses #-} @@ -324,7 +330,7 @@ -- 'listening' :: ('MonadWriter' w m, 'Monoid' u) => 'Traversal'' w u -> m a -> m (a, u) -- 'listening' :: ('MonadWriter' w m, 'Monoid' u) => 'Prism'' w u     -> m a -> m (a, u) -- @-listening :: MonadWriter w m => Getting u w t u b -> m a -> m (a, u)+listening :: MonadWriter w m => Getting u w u -> m a -> m (a, u) listening l m = do   (a, w) <- listen m   return (a, view l w)@@ -341,7 +347,7 @@ -- 'ilistening' :: ('MonadWriter' w m, 'Monoid' u) => 'IndexedFold' i w u       -> m a -> m (a, (i, u)) -- 'ilistening' :: ('MonadWriter' w m, 'Monoid' u) => 'IndexedTraversal'' i w u -> m a -> m (a, (i, u)) -- @-ilistening :: MonadWriter w m => IndexedGetting i (i, u) w t u b -> m a -> m (a, (i, u))+ilistening :: MonadWriter w m => IndexedGetting i (i, u) w u -> m a -> m (a, (i, u)) ilistening l m = do   (a, w) <- listen m   return (a, iview l w)@@ -360,7 +366,7 @@ -- 'listenings' :: ('MonadWriter' w m, 'Monoid' v) => 'Traversal'' w u -> (u -> v) -> m a -> m (a, v) -- 'listenings' :: ('MonadWriter' w m, 'Monoid' v) => 'Prism'' w u     -> (u -> v) -> m a -> m (a, v) -- @-listenings :: MonadWriter w m => Getting v w t u b -> (u -> v) -> m a -> m (a, v)+listenings :: MonadWriter w m => Getting v w u -> (u -> v) -> m a -> m (a, v) listenings l uv m = do   (a, w) <- listen m   return (a, views l uv w)@@ -377,165 +383,13 @@ -- 'ilistenings' :: ('MonadWriter' w m, 'Monoid' v) => 'IndexedFold' w u       -> (i -> u -> v) -> m a -> m (a, v) -- 'ilistenings' :: ('MonadWriter' w m, 'Monoid' v) => 'IndexedTraversal'' w u -> (i -> u -> v) -> m a -> m (a, v) -- @-ilistenings :: MonadWriter w m => IndexedGetting i v w t u b -> (i -> u -> v) -> m a -> m (a, v)+ilistenings :: MonadWriter w m => IndexedGetting i v w u -> (i -> u -> v) -> m a -> m (a, v) ilistenings l iuv m = do   (a, w) <- listen m   return (a, iviews l iuv w) {-# INLINE ilistenings #-} --- | View the value of a 'Getter', 'Control.Lens.Iso.Iso',- --------------------------------------------------------------------------------- Accessing State, Simplified----------------------------------------------------------------------------------- | This is a type restricted version of 'use' that expects a 'Simple' 'Getter'.------ Use the target of a 'Lens'', 'Control.Lens.Iso.Iso', or--- 'Getter' in the current state, or use a summary of a--- 'Control.Lens.Fold.Fold' or 'Control.Lens.Traversal.Traversal' that points--- to a monoidal value.------ This use of this combinator may aid type-inference when working with lenses or traversals that--- have non-defaultable typeclass constraints on their arguments.------ >>> evalState (use' _1) (a,b)--- a--------- >>> evalState (use' _1) ("hello","world")--- "hello"------ @--- 'use'' :: 'MonadState' s m             => 'Getter' s a     -> m a--- 'use'' :: ('MonadState' s m, 'Data.Monoid.Monoid' r) => 'Control.Lens.Fold.Fold' s r       -> m r--- 'use'' :: 'MonadState' s m             => 'Control.Lens.Iso.Iso'' s a       -> m a--- 'use'' :: 'MonadState' s m             => 'Lens'' s a      -> m a--- 'use'' :: ('MonadState' s m, 'Data.Monoid.Monoid' r) => 'Control.Lens.Traversal.Traversal'' s r -> m r--- @-use' :: MonadState s m => Getting a s s a a -> m a-use' l = State.gets (view' l)-{-# INLINE use' #-}---- | This is a type restricted version of 'uses' that expects a 'Simple' 'Getter'.------ Use the target of a 'Lens', 'Control.Lens.Iso.Iso' or--- 'Getter' in the current state, or use a summary of a--- 'Control.Lens.Fold.Fold' or 'Control.Lens.Traversal.Traversal' that--- points to a monoidal value.------ >>> evalState (uses' _1 length) ("hello","world")--- 5------ @--- 'uses'' :: 'MonadState' s m             => 'Getter' s a     -> (a -> r) -> m r--- 'uses'' :: ('MonadState' s m, 'Data.Monoid.Monoid' r) => 'Control.Lens.Fold.Fold' s a       -> (a -> r) -> m r--- 'uses'' :: 'MonadState' s m             => 'Lens'' s a      -> (a -> r) -> m r--- 'uses'' :: 'MonadState' s m             => 'Control.Lens.Iso.Iso'' s a       -> (a -> r) -> m r--- 'uses'' :: ('MonadState' s m, 'Data.Monoid.Monoid' r) => 'Control.Lens.Traversal.Traversal'' s a -> (a -> r) -> m r--- @------ @--- 'uses'' :: 'MonadState' s m => 'Getting' r s s a a -> (a -> r) -> m r--- @-uses' :: (Profunctor p, MonadState s m) => Overloading' p (->) (Accessor r) s a -> p a r -> m r-uses' l f = State.gets (views' l f)-{-# INLINE uses' #-}----------------------------------------------------------------------------------- Viewing, Simplified----------------------------------------------------------------------------------- | This is a type restricted version of 'view' that expects a 'Simple' 'Getter'.------ View the value pointed to by a 'Getter', 'Control.Lens.Iso.Iso' or--- 'Lens' or the result of folding over all the results of a--- 'Control.Lens.Fold.Fold' or 'Control.Lens.Traversal.Traversal' that points--- at a monoidal values.------ @--- 'view'' '.' 'to' ≡ 'id'--- @------ >>> view' (to f) a--- f a------ >>> view' _2 (1,"hello")--- "hello"------ >>> view' (to succ) 5--- 6------ >>> view' (_2._1) ("hello",("world","!!!"))--- "world"------ As 'view'' is commonly used to access the target of a 'Getter' or obtain a monoidal summary of the targets of a 'Fold',--- It may be useful to think of it as having one of these more restricted signatures:------ @--- 'view'' ::             'Getter' s a     -> s -> a--- 'view'' :: 'Data.Monoid.Monoid' m => 'Control.Lens.Fold.Fold' s m       -> s -> m--- 'view'' ::             'Control.Lens.Iso.Iso'' s a       -> s -> a--- 'view'' ::             'Lens'' s a      -> s -> a--- 'view'' :: 'Data.Monoid.Monoid' m => 'Control.Lens.Traversal.Traversal'' s m -> s -> m--- @------ In a more general setting, such as when working with a 'Monad' transformer stack you can use:------ @--- 'view'' :: 'MonadReader' s m             => 'Getter' s a     -> m a--- 'view'' :: ('MonadReader' s m, 'Data.Monoid.Monoid' a) => 'Control.Lens.Fold.Fold' s a       -> m a--- 'view'' :: 'MonadReader' s m             => 'Control.Lens.Iso.Iso'' s a       -> m a--- 'view'' :: 'MonadReader' s m             => 'Lens'' s a      -> m a--- 'view'' :: ('MonadReader' s m, 'Data.Monoid.Monoid' a) => 'Control.Lens.Traversal.Traversal'' s a -> m a--- @-view' :: MonadReader s m => Getting a s s a a -> m a-view' l = Reader.asks (runAccessor #. l Accessor)-{-# INLINE view' #-}---- | This is a type restricted version of 'views' that expects a 'Simple' 'Getter'.------ View the value of a 'Getter', 'Control.Lens.Iso.Iso',--- 'Lens' or the result of folding over the result of mapping--- the targets of a 'Control.Lens.Fold.Fold' or--- 'Control.Lens.Traversal.Traversal'.------ @--- 'views'' l f ≡ 'view'' (l '.' 'to' f)--- @------ >>> views' _2 length (1,"hello")--- 5------ As 'views'' is commonly used to access the target of a 'Getter' or obtain a monoidal summary of the targets of a 'Fold',--- It may be useful to think of it as having one of these more restricted signatures:------ @--- 'views'' ::             'Getter' s a     -> (a -> r) -> s -> r--- 'views'' :: 'Data.Monoid.Monoid' m => 'Control.Lens.Fold.Fold' s a       -> (a -> m) -> s -> m--- 'views'' ::             'Control.Lens.Iso.Iso'' s a       -> (a -> r) -> s -> r--- 'views'' ::             'Lens'' s a      -> (a -> r) -> s -> r--- 'views'' :: 'Data.Monoid.Monoid' m => 'Control.Lens.Traversal.Traversal'' s a -> (a -> m) -> s -> m--- @------ In a more general setting, such as when working with a 'Monad' transformer stack you can use:------ @--- 'views'' :: 'MonadReader' s m             => 'Getter' s a     -> (a -> r) -> m r--- 'views'' :: ('MonadReader' s m, 'Data.Monoid.Monoid' a) => 'Control.Lens.Fold.Fold' s a       -> (a -> r) -> m r--- 'views'' :: 'MonadReader' s m             => 'Control.Lens.Iso.Iso'' s a       -> (a -> r) -> m r--- 'views'' :: 'MonadReader' s m             => 'Lens'' s a      -> (a -> r) -> m r--- 'views'' :: ('MonadReader' s m, 'Data.Monoid.Monoid' a) => 'Control.Lens.Traversal.Traversal'' s a -> (a -> r) -> m r--- @------ @--- 'views'' :: 'MonadReader' s m => 'Getting' r s s a a -> (a -> r) -> m r--- @-views' :: (Profunctor p, MonadReader s m) => Overloading' p (->) (Accessor r) s a -> p a r -> m r-views' l f = Reader.asks (runAccessor #. l (rmap Accessor f))-{-# INLINE views' #-}-------------------------------------------------------------------------------- -- Indexed Getters ------------------------------------------------------------------------------ @@ -543,7 +397,7 @@ -- -- When applied to an 'IndexedFold' the result will most likely be a nonsensical monoidal summary of -- the indices tupled with a monoidal summary of the values and probably not whatever it is you wanted.-iview :: MonadReader s m => IndexedGetting i (i,a) s t a b -> m (i,a)+iview :: MonadReader s m => IndexedGetting i (i,a) s a -> m (i,a) iview l = asks (runAccessor #. l (Indexed $ \i -> Accessor #. (,) i)) {-# INLINE iview #-} @@ -554,7 +408,7 @@ -- @ -- 'iviews' ≡ 'Control.Lens.Fold.ifoldMapOf' -- @-iviews :: MonadReader s m => IndexedGetting i r s t a b -> (i -> a -> r) -> m r+iviews :: MonadReader s m => IndexedGetting i r s a -> (i -> a -> r) -> m r iviews l = views l .# Indexed {-# INLINE iviews #-} @@ -562,14 +416,14 @@ -- -- When applied to an 'IndexedFold' the result will most likely be a nonsensical monoidal summary of -- the indices tupled with a monoidal summary of the values and probably not whatever it is you wanted.-iuse :: MonadState s m => IndexedGetting i (i,a) s t a b -> m (i,a)+iuse :: MonadState s m => IndexedGetting i (i,a) s a -> m (i,a) iuse l = gets (runAccessor #. l (Indexed $ \i -> Accessor #. (,) i)) {-# INLINE iuse #-}  -- | Use a function of the index and value of an 'IndexedGetter' into the current state. -- -- When applied to an 'IndexedFold' the result will be a monoidal summary instead of a single answer.-iuses :: MonadState s m => IndexedGetting i r s t a b -> (i -> a -> r) -> m r+iuses :: MonadState s m => IndexedGetting i r s a -> (i -> a -> r) -> m r iuses l = uses l .# Indexed {-# INLINE iuses #-} @@ -592,6 +446,11 @@ -- @ -- -- The result probably doesn't have much meaning when applied to an 'IndexedFold'.-(^@.) :: s -> IndexedGetting i (i, a) s t a b -> (i, a)+(^@.) :: s -> IndexedGetting i (i, a) s a -> (i, a) s ^@. l = runAccessor $ l (Indexed $ \i -> Accessor #. (,) i) s {-# INLINE (^@.) #-}++-- | Coerce a 'Gettable' 'LensLike' to a 'Simple' 'LensLike'. This is useful+-- when using a 'Traversal' that is not simple as a 'Getter' or a 'Fold'.+coerced :: (Functor f, Contravariant f) => LensLike f s t a b -> LensLike' f s a+coerced l f = coerce . l (coerce . f)

@@ -88,6 +88,7 @@ import Control.Lens.Traversal import Control.Lens.Type import Data.Foldable+import Data.Functor.Contravariant import Data.Functor.Identity import Data.Functor.Reverse import Data.Hashable@@ -158,7 +159,7 @@  -- | When composed with an 'IndexedFold' or 'IndexedTraversal' this yields an -- ('Indexed') 'Fold' of the indices.-asIndex :: (Indexable i p, Functor f, Gettable f) => Overloading' p (Indexed i) f s i+asIndex :: (Indexable i p, Contravariant f, Functor f) => Overloading' p (Indexed i) f s i asIndex f = Indexed $ \i _ -> coerce (indexed f i i) {-# INLINE asIndex #-} @@ -250,6 +251,7 @@   -- @   ifoldr   :: (i -> a -> b -> b) -> b -> f a -> b   ifoldr f z t = appEndo (ifoldMap (\i -> Endo #. f i) t) z+  {-# INLINE ifoldr #-}    -- | Left-associative fold of an indexed container with access to the index @i@.   --@@ -260,6 +262,7 @@   -- @   ifoldl :: (i -> b -> a -> b) -> b -> f a -> b   ifoldl f z t = appEndo (getDual (ifoldMap (\i -> Dual #. Endo #. flip (f i)) t)) z+  {-# INLINE ifoldl #-}    -- | /Strictly/ fold right over the elements of a structure with access to the index @i@.   --@@ -271,6 +274,7 @@   ifoldr' :: (i -> a -> b -> b) -> b -> f a -> b   ifoldr' f z0 xs = ifoldl f' id xs z0     where f' i k x z = k $! f i x z+  {-# INLINE ifoldr' #-}    -- | Fold over the elements of a structure with an index, associating to the left, but /strictly/.   --@@ -282,6 +286,7 @@   ifoldl' :: (i -> b -> a -> b) -> b -> f a -> b   ifoldl' f z0 xs = ifoldr f' id xs z0     where f' i x k z = k $! f i z x+  {-# INLINE ifoldl' #-}  -- | Obtain a 'Fold' by lifting an operation that returns a 'Foldable' result. --@@ -451,7 +456,6 @@   itraversed = conjoined traverse (itraverse . indexed)   {-# INLINE itraversed #-} - -- | Traverse with an index (and the arguments flipped). -- -- @@@ -515,30 +519,39 @@  instance FunctorWithIndex i f => FunctorWithIndex i (Backwards f) where   imap f  = Backwards . imap f . forwards+  {-# INLINE imap #-}  instance FoldableWithIndex i f => FoldableWithIndex i (Backwards f) where   ifoldMap f = ifoldMap f . forwards+  {-# INLINE ifoldMap #-}  instance TraversableWithIndex i f => TraversableWithIndex i (Backwards f) where   itraverse f = fmap Backwards . itraverse f . forwards+  {-# INLINE itraverse #-}  instance FunctorWithIndex i f => FunctorWithIndex i (Reverse f) where   imap f = Reverse . imap f . getReverse+  {-# INLINE imap #-}  instance FoldableWithIndex i f => FoldableWithIndex i (Reverse f) where   ifoldMap f = getDual . ifoldMap (\i -> Dual #. f i) . getReverse+  {-# INLINE ifoldMap #-}  instance TraversableWithIndex i f => TraversableWithIndex i (Reverse f) where   itraverse f = fmap Reverse . forwards . itraverse (\i -> Backwards . f i) . getReverse+  {-# INLINE itraverse #-}  instance FunctorWithIndex () Identity where   imap f (Identity a) = Identity (f () a)+  {-# INLINE imap #-}  instance FoldableWithIndex () Identity where   ifoldMap f (Identity a) = f () a+  {-# INLINE ifoldMap #-}  instance TraversableWithIndex () Identity where   itraverse f (Identity a) = Identity <$> f () a+  {-# INLINE itraverse #-}  instance FunctorWithIndex k ((,) k) where   imap f (k,a) = (k, f k a)@@ -563,6 +576,16 @@   itraverse = itraverseOf traversed   {-# INLINE itraverse #-} +instance FunctorWithIndex () Maybe where+  imap f = fmap (f ())+  {-# INLINE imap #-}+instance FoldableWithIndex () Maybe where+  ifoldMap f = foldMap (f ())+  {-# INLINE ifoldMap #-}+instance TraversableWithIndex () Maybe where+  itraverse f = traverse (f ())+  {-# INLINE itraverse #-}+ -- | The position in the 'Seq' is available as the index. instance FunctorWithIndex Int Seq where   imap = iover itraversed@@ -581,9 +604,13 @@   ifoldMap = ifoldMapOf itraversed   {-# INLINE ifoldMap #-}   ifoldr = V.ifoldr+  {-# INLINE ifoldr #-}   ifoldl = V.ifoldl . flip+  {-# INLINE ifoldl #-}   ifoldr' = V.ifoldr'+  {-# INLINE ifoldr' #-}   ifoldl' = V.ifoldl' . flip+  {-# INLINE ifoldl' #-} instance TraversableWithIndex Int Vector where   itraverse f = sequenceA . V.imap f   {-# INLINE itraverse #-}

@@ -30,6 +30,7 @@ import Control.Lens.Internal.Getter import Control.Monad import Data.Functor.Bind+import Data.Functor.Contravariant import Data.Functor.Identity import Data.Profunctor.Unsafe import Data.Semigroup@@ -41,7 +42,7 @@ -- | An 'Effective' 'Functor' ignores its argument and is isomorphic to a 'Monad' wrapped around a value. -- -- That said, the 'Monad' is possibly rather unrelated to any 'Applicative' structure.-class (Monad m, Gettable f) => Effective m r f | f -> m r where+class (Monad m, Functor f, Contravariant f) => Effective m r f | f -> m r where   effective :: m r -> f a   ineffective :: f a -> m r @@ -68,9 +69,9 @@   fmap _ (Effect m) = Effect m   {-# INLINE fmap #-} -instance Gettable (Effect m r) where-  coerce (Effect m) = Effect m-  {-# INLINE coerce #-}+instance Contravariant (Effect m r) where+  contramap _ (Effect m) = Effect m+  {-# INLINE contramap #-}  instance Monad m => Effective m r (Effect m r) where   effective = Effect

@@ -28,10 +28,10 @@ import Control.Category import Control.Comonad import Control.Lens.Internal.Context-import Control.Lens.Internal.Getter import Control.Lens.Internal.Indexed import Data.Functor.Apply import Data.Functor.Compose+import Data.Functor.Contravariant import Data.Functor.Identity import Data.Profunctor import Data.Profunctor.Rep@@ -121,8 +121,8 @@ -- BazaarT ------------------------------------------------------------------------------ --- | 'BazaarT' is like 'Bazaar', except that it provides a questionable 'Gettable' instance--- To protect this instance it relies on the soundness of another 'Gettable' type, and usage conventions.+-- | 'BazaarT' is like 'Bazaar', except that it provides a questionable 'Contravariant' instance+-- To protect this instance it relies on the soundness of another 'Contravariant' type, and usage conventions. -- -- For example. This lets us write a suitably polymorphic and lazy 'Control.Lens.Traversal.taking', but there -- must be a better way!@@ -177,6 +177,6 @@   (<@>) = (<*>)   {-# INLINE (<@>) #-} -instance (Profunctor p, Gettable g) => Gettable (BazaarT p g a b) where-  coerce = (<$) (error "coerced BazaarT")-  {-# INLINE coerce #-}+instance (Profunctor p, Contravariant g) => Contravariant (BazaarT p g a b) where+  contramap _ = (<$) (error "contramap: BazaarT")+  {-# INLINE contramap #-}

@@ -95,20 +95,19 @@ -- | Traverse a strict 'B.ByteString' in a relatively balanced fashion, as a balanced tree with biased runs of -- elements at the leaves. traversedStrictTree :: Int -> IndexedTraversal' Int B.ByteString Word8-traversedStrictTree i0 pafb (BI.PS fp off len) = rebuild len <$> go i0 (i0 + len)+traversedStrictTree i0 pafb (BI.PS fp off len) = rebuild len <$> go (unsafeForeignPtrToPtr fp `plusPtr` (off - i0)) i0 (i0 + len)  where-   p = unsafeForeignPtrToPtr fp `plusPtr` (off - i0)-   rebuild n f = unsafeCreate n $ \q -> f (q `plusPtr` (off - i0))-   go !i !j-     | i + grain < j, k <- i + shiftR (j - i) 1 = (\l r q -> l q >> r q) <$> go i k <*> go k j-     | otherwise = run i j-   run !i !j+   rebuild n f = unsafeCreate n $ \q -> f $! (q `plusPtr` (off - i0))+   go !p !i !j+     | i + grain < j, k <- i + shiftR (j - i) 1 = (\l r q -> l q >> r q) <$> go p i k <*> go p k j+     | otherwise = run p i j+   run !p !i !j      | i == j    = pure (\_ -> return ())      | otherwise = let !x = BI.inlinePerformIO $ do                           x' <- peekByteOff p i                           touchForeignPtr fp                           return x'-                   in (\y ys q -> poke (q `plusPtr` i) y >> ys q) <$> indexed pafb (i :: Int) x <*> run (i + 1) j+                   in (\y ys !q -> pokeByteOff q i y >> ys q) <$> indexed pafb (i :: Int) x <*> run p (i + 1) j {-# INLINE traversedStrictTree #-}  -- | Traverse a strict 'B.ByteString' in a relatively balanced fashion, as a balanced tree with biased runs of

@@ -34,9 +34,9 @@ import Control.Category import Control.Comonad import Control.Comonad.Store.Class-import Control.Lens.Internal.Getter import Control.Lens.Internal.Indexed import Data.Functor.Compose+import Data.Functor.Contravariant import Data.Functor.Identity import Data.Profunctor import Data.Profunctor.Rep@@ -338,9 +338,9 @@   sell = cotabulate $ \ w -> PretextT (`corep` w)   {-# INLINE sell #-} -instance (Profunctor p, Gettable g) => Gettable (PretextT p g a b) where-  coerce = (<$) (error "coerced PretextT")-  {-# INLINE coerce #-}+instance (Profunctor p, Contravariant g) => Contravariant (PretextT p g a b) where+  contramap _ = (<$) (error "contramap: PretextT")+  {-# INLINE contramap #-}  ------------------------------------------------------------------------------ -- Utilities

@@ -30,6 +30,7 @@ import Control.Lens.Cons import Control.Lens.Fold import Control.Lens.Indexed hiding ((<.>))+import Control.Lens.Iso import Control.Lens.Prism import Control.Monad import Data.Foldable as Foldable@@ -124,6 +125,10 @@     | size xs < size ys = Foldable.foldr cons ys xs     | otherwise         = Foldable.foldl snoc xs ys   {-# INLINE (<|>) #-}++instance Reversing (Deque a) where+  reversing (BD lf f lr r) = BD lr r lf f+  {-# INLINE reversing #-}  instance Bind Deque where   ma >>- k = fromList (toList ma >>= toList . k)

@@ -84,7 +84,7 @@   -- 'handler' :: 'Control.Lens.Lens.Lens''      e a -> (a -> m r) -> 'Control.Monad.Error.Lens.Handler' e m r   -- 'handler' :: 'Control.Lens.Traversal.Traversal'' e a -> (a -> m r) -> 'Control.Monad.Error.Lens.Handler' e m r   -- @-  handler :: Getting (First a) e t a b -> (a -> m r) -> h r+  handler :: Getting (First a) e a -> (a -> m r) -> h r    -- | This builds a 'Handler' for just the targets of a given 'Control.Lens.Prism.Prism' (or any 'Getter', really).   -- that ignores its input and just recovers with the stated monadic action.@@ -124,7 +124,7 @@   -- 'handler_' :: 'Control.Lens.Lens.Lens''      e a -> m r -> 'Control.Monad.Error.Lens.Handler' e m r   -- 'handler_' :: 'Control.Lens.Traversal.Traversal'' e a -> m r -> 'Control.Monad.Error.Lens.Handler' e m r   -- @-  handler_ :: Getting (First a) e t a b -> m r -> h r+  handler_ :: Getting (First a) e a -> m r -> h r   handler_ l = handler l . const   {-# INLINE handler_ #-} @@ -134,10 +134,10 @@ instance Handleable SomeException m (CatchIO.Handler m) where   handler = handlerCatchIO -handlerIO :: forall t a b r. Getting (First a) SomeException t a b -> (a -> IO r) -> Exception.Handler r+handlerIO :: forall a r. Getting (First a) SomeException a -> (a -> IO r) -> Exception.Handler r handlerIO l f = reify (preview l) $ \ (_ :: Proxy s) -> Exception.Handler (\(Handling a :: Handling a s IO) -> f a) -handlerCatchIO :: forall m t a b r. Getting (First a) SomeException t a b -> (a -> m r) -> CatchIO.Handler m r+handlerCatchIO :: forall m a r. Getting (First a) SomeException a -> (a -> m r) -> CatchIO.Handler m r handlerCatchIO l f = reify (preview l) $ \ (_ :: Proxy s) -> CatchIO.Handler (\(Handling a :: Handling a s m) -> f a)  ------------------------------------------------------------------------------

@@ -26,27 +26,27 @@  import Control.Applicative import Control.Lens.Internal.Getter-import Data.Maybe import Data.Functor.Bind+import Data.Functor.Contravariant+import Data.Maybe import Data.Semigroup hiding (Min, getMin, Max, getMax)  ------------------------------------------------------------------------------ -- Folding ------------------------------------------------------------------------------ --- | A 'Monoid' for a 'Gettable' 'Applicative'.+-- | A 'Monoid' for a 'Contravariant' 'Applicative'. newtype Folding f a = Folding { getFolding :: f a } -instance (Gettable f, Apply f) => Semigroup (Folding f a) where+instance (Contravariant f, Apply f) => Semigroup (Folding f a) where   Folding fr <> Folding fs = Folding (fr .> fs)   {-# INLINE (<>) #-} -instance (Gettable f, Applicative f) => Monoid (Folding f a) where+instance (Contravariant f, Applicative f) => Monoid (Folding f a) where   mempty = Folding noEffect   {-# INLINE mempty #-}   Folding fr `mappend` Folding fs = Folding (fr *> fs)   {-# INLINE mappend #-}-  ------------------------------------------------------------------------------ -- Traversed

@@ -1,7 +1,5 @@-{-# LANGUAGE CPP #-}-#ifdef TRUSTWORTHY-{-# LANGUAGE Trustworthy #-}-#endif+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-} ----------------------------------------------------------------------------- -- | -- Module      :  Control.Lens.Internal.Getter@@ -15,54 +13,43 @@ module Control.Lens.Internal.Getter   (   -- * Internal Classes+    Gettable   -- ** Getters-    Gettable(..)+  , coerce   , noEffect   , Accessor(..)   ) where  import Control.Applicative-import Control.Applicative.Backwards import Data.Functor.Apply-import Data.Functor.Compose-import Data.Profunctor.Unsafe+import Data.Functor.Contravariant import Data.Semigroup+import Data.Void +-- | This class is provided mostly for backwards compatibility with lens 3.8,+-- but it can also shorten type signatures.+class (Contravariant f, Functor f) => Gettable f+instance (Contravariant f, Functor f) => Gettable f+ ------------------------------------------------------------------------------- -- Gettables & Accessors ------------------------------------------------------------------------------- --- | Generalizing 'Const' so we can apply simple 'Applicative'+-- | This Generalizes 'Const' so we can apply simple 'Applicative' -- transformations to it and so we can get nicer error messages. ----- A 'Gettable' 'Functor' ignores its argument, which it carries solely as a+-- A 'Functor' you can 'coerce' ignores its argument, which it carries solely as a -- phantom type parameter. ----- To ensure this, an instance of 'Gettable' is required to satisfy:------ @'id' = 'fmap' f = 'coerce'@+-- By the 'Functor' and 'Contravariant' laws, an instance of 'Gettable' will necessarily satisfy: ----- Which is equivalent to making a @'Gettable' f@ an \"anyvariant\"--- 'Functor'.--class Functor f => Gettable f where-  -- | Replace the phantom type argument.-  coerce :: f a -> f b--instance Gettable (Const r) where-  coerce (Const m) = Const m-  {-# INLINE coerce #-}--instance Gettable f => Gettable (Backwards f) where-  coerce = Backwards #. coerce .# forwards-  {-# INLINE coerce #-}--instance (Functor f, Gettable g) => Gettable (Compose f g) where-  coerce = Compose #. fmap coerce .# getCompose-  {-# INLINE coerce #-}+-- @'id' = 'fmap' f = 'coerce' = 'contramap' g@+coerce :: (Contravariant f, Functor f) => f a -> f b+coerce a = absurd <$> contramap absurd a+{-# INLINE coerce #-}  -- | The 'mempty' equivalent for a 'Gettable' 'Applicative' 'Functor'.-noEffect :: (Applicative f, Gettable f) => f a+noEffect :: (Contravariant f, Applicative f) => f a noEffect = coerce $ pure () {-# INLINE noEffect #-} @@ -82,6 +69,10 @@   fmap _ (Accessor m) = Accessor m   {-# INLINE fmap #-} +instance Contravariant (Accessor r) where+  contramap _ (Accessor m) = Accessor m+  {-# INLINE contramap #-}+ instance Semigroup r => Apply (Accessor r) where   Accessor a <.> Accessor b = Accessor (a <> b)   {-# INLINE (<.>) #-}@@ -91,7 +82,3 @@   {-# INLINE pure #-}   Accessor a <*> Accessor b = Accessor (mappend a b)   {-# INLINE (<*>) #-}--instance Gettable (Accessor r) where-  coerce (Accessor m) = Accessor m-  {-# INLINE coerce #-}

@@ -37,12 +37,12 @@ import Control.Arrow as Arrow import Control.Category import Control.Comonad-import Control.Lens.Internal.Getter import Control.Lens.Internal.Instances () import Control.Monad import Control.Monad.Fix import Data.Distributive import Data.Functor.Bind+import Data.Functor.Contravariant import Data.Int import Data.Profunctor import Data.Profunctor.Rep@@ -244,10 +244,10 @@        ~(k, fa) -> (k, ff <*> fa)   {-# INLINE (<*>) #-} -instance Gettable f => Gettable (Indexing f) where-  coerce (Indexing m) = Indexing $ \i -> case m i of-    (j, ff) -> (j, coerce ff)-  {-# INLINE coerce #-}+instance Contravariant f => Contravariant (Indexing f) where+  contramap f (Indexing m) = Indexing $ \i -> case m i of+    (j, ff) -> (j, contramap f ff)+  {-# INLINE contramap #-}  -- | 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.@@ -293,10 +293,10 @@        ~(k, fa) -> (k, ff <*> fa)   {-# INLINE (<*>) #-} -instance Gettable f => Gettable (Indexing64 f) where-  coerce (Indexing64 m) = Indexing64 $ \i -> case m i of-    (j, ff) -> (j, coerce ff)-  {-# INLINE coerce #-}+instance Contravariant f => Contravariant (Indexing64 f) where+  contramap f (Indexing64 m) = Indexing64 $ \i -> case m i of+    (j, ff) -> (j, contramap f ff)+  {-# INLINE contramap #-}  -- | 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.

@@ -14,6 +14,7 @@ ---------------------------------------------------------------------------- module Control.Lens.Internal.Iso   ( Exchange(..)+  , Reversing(..)   ) where  import Data.Profunctor@@ -21,6 +22,15 @@ #ifndef SAFE import Unsafe.Coerce #endif+import Data.ByteString       as StrictB+import Data.ByteString.Lazy  as LazyB+import Data.Text             as StrictT+import Data.Text.Lazy        as LazyT+import Data.Vector           as Vector+import Data.Vector.Primitive as Prim+import Data.Vector.Storable  as Storable+import Data.Vector.Unboxed   as Unbox+import Data.Sequence         as Seq  ------------------------------------------------------------------------------ -- Isomorphism: Exchange@@ -45,3 +55,41 @@   {-# INLINE ( #. ) #-}   ( .# ) p _ = unsafeCoerce p   {-# INLINE ( .# ) #-}++------------------------------------------------------------------------------+-- Reversible+------------------------------------------------------------------------------++-- | This class provides a generalized notion of list reversal extended to other containers.+class Reversing t where+  reversing :: t -> t++instance Reversing [a] where+  reversing = Prelude.reverse++instance Reversing StrictB.ByteString where+  reversing = StrictB.reverse++instance Reversing LazyB.ByteString where+  reversing = LazyB.reverse++instance Reversing StrictT.Text where+  reversing = StrictT.reverse++instance Reversing LazyT.Text where+  reversing = LazyT.reverse++instance Reversing (Vector.Vector a) where+  reversing = Vector.reverse++instance Reversing (Seq a) where+  reversing = Seq.reverse++instance Prim a => Reversing (Prim.Vector a) where+  reversing = Prim.reverse++instance Unbox a => Reversing (Unbox.Vector a) where+  reversing = Unbox.reverse++instance Storable a => Reversing (Storable.Vector a) where+  reversing = Storable.reverse

@@ -41,10 +41,10 @@ import Control.Comonad import Control.Lens.Internal.Bazaar import Control.Lens.Internal.Context-import Control.Lens.Internal.Getter import Control.Lens.Internal.Indexed import Data.Foldable import Data.Functor.Apply+import Data.Functor.Contravariant import Data.Monoid import Data.Profunctor.Rep import Data.Profunctor.Unsafe@@ -240,8 +240,9 @@     go (Magma _ wa) = corep pafb wa   {-# INLINE bazaar #-} -instance Gettable f => Gettable (TakingWhile p f a b) where-  coerce = (<$) (error "coerced TakingWhile")+instance Contravariant f => Contravariant (TakingWhile p f a b) where+  contramap _ = (<$) (error "contramap: TakingWhile")+  {-# INLINE contramap #-}  instance IndexedFunctor (TakingWhile p f) where   ifmap = fmap

@@ -19,10 +19,12 @@ -- ---------------------------------------------------------------------------- module Control.Lens.Internal.Review-  (-  -- ** Reviewing-    Reviewable(..)-  , Reviewed(..)+  ( +  -- * Internal Classes+    Reviewable,+  -- * Reviews+    retagged,+    Reviewed(..)   ) where  import Control.Applicative@@ -38,24 +40,16 @@ import Data.Profunctor.Rep import Data.Profunctor.Unsafe import Data.Proxy-import Data.Tagged import Data.Traversable+import Data.Void #ifndef SAFE import Unsafe.Coerce #endif --------------------------------------------------------------------------------- Reviewable--------------------------------------------------------------------------------- | This provides a dual notion to that of 'Control.Lens.Getter.Gettable'.-class Profunctor p => Reviewable p where-  retagged :: p a b -> p s b-  -- retaggedDot, dotRetagged?--instance Reviewable Tagged where-  retagged = retag-  {-# INLINE retagged #-}+-- | This class is provided mostly for backwards compatibility with lens 3.8,+-- but it can also shorten type signatures.+class (Profunctor p, Bifunctor p) => Reviewable p+instance (Profunctor p, Bifunctor p) => Reviewable p  ------------------------------------------------------------------------------ -- Review: Reviewed@@ -65,11 +59,10 @@ -- -- It plays a role similar to that of 'Control.Lens.Internal.Getter.Accessor' -- or 'Const' do for "Control.Lens.Getter"-newtype Reviewed a b = Reviewed { runReviewed :: b }+retagged :: (Profunctor p, Bifunctor p) => p a b -> p s b+retagged = first absurd . lmap absurd -instance Reviewable Reviewed where-  retagged (Reviewed b) = Reviewed b-  {-# INLINE retagged #-}+newtype Reviewed a b = Reviewed { runReviewed :: b }  instance Functor (Reviewed a) where   fmap bc (Reviewed b) = Reviewed (bc b)

@@ -26,6 +26,7 @@ import Data.Foldable import Data.Functor.Bind import Data.Functor.Compose+import Data.Functor.Extend import Data.Functor.Identity import Data.Profunctor import Data.Profunctor.Unsafe@@ -92,6 +93,8 @@ instance Bind Mutator where   Mutator x >>- f = f x   {-# INLINE (>>-) #-}+  join = runMutator+  {-# INLINE join #-}  instance Monad Mutator where   return = Mutator@@ -99,6 +102,12 @@   Mutator x >>= f = f x   {-# INLINE (>>=) #-} +instance Extend Mutator where+  extended f w = Mutator (f w)+  {-# INLINE extended #-}+  duplicated = Mutator+  {-# INLINE duplicated #-}+ instance Comonad Mutator where   extract = runMutator   {-# INLINE extract #-}@@ -108,7 +117,7 @@   {-# INLINE duplicate #-}  instance ComonadApply Mutator where-  (<@>) = (<*>)+  Mutator f <@> Mutator a = Mutator (f a)   {-# INLINE (<@>) #-}  instance Distributive Mutator where

@@ -49,6 +49,7 @@ import Control.Monad.Trans.Identity import Control.Monad.Trans.Maybe import Data.Functor.Bind+import Data.Functor.Contravariant import Data.Semigroup import Prelude hiding ((.),id) @@ -287,6 +288,6 @@   EffectRWS m <*> EffectRWS n = EffectRWS $ \st -> m st >>= \ (s,t,w) -> n t >>= \ (s',u,w') -> return (mappend s s', u, mappend w w')   {-# INLINE (<*>) #-} -instance Gettable (EffectRWS w st m s) where-  coerce (EffectRWS m) = EffectRWS m-  {-# INLINE coerce #-}+instance Contravariant (EffectRWS w st m s) where+  contramap _ (EffectRWS m) = EffectRWS m+  {-# INLINE contramap #-}

@@ -44,32 +44,43 @@   , flipped   , Swapped(..)   , Strict(..)+  , Reversing(..), reversed+  , involuted   -- ** Uncommon Isomorphisms   , magma   , imagma   , Magma+  -- ** Contravariant functors+  , contramapping   -- * Profunctors   , Profunctor(dimap,rmap,lmap)+  , dimapping+  , lmapping+  , rmapping   ) where  import Control.Lens.Internal.Context import Control.Lens.Internal.Indexed-import Control.Lens.Internal.Iso+import Control.Lens.Internal.Iso as Iso import Control.Lens.Internal.Magma import Control.Lens.Internal.Setter import Control.Lens.Type+import Control.Monad.State.Lazy as Lazy+import Control.Monad.State.Strict as Strict+import Control.Monad.Writer.Lazy as Lazy+import Control.Monad.Writer.Strict as Strict+import Control.Monad.RWS.Lazy as Lazy+import Control.Monad.RWS.Strict as Strict import Data.Bifunctor-import Data.ByteString as StrictB-import Data.ByteString.Lazy as LazyB-import Data.Text as StrictT-import Data.Text.Lazy as LazyT+import Data.ByteString as StrictB hiding (reverse)+import Data.ByteString.Lazy as LazyB hiding (reverse)+import Data.Functor.Contravariant+import Data.Text as StrictT hiding (reverse)+import Data.Text.Lazy as LazyT hiding (reverse) import Data.Tuple (swap) import Data.Maybe import Data.Profunctor import Data.Profunctor.Unsafe-#ifndef SAFE-import Unsafe.Coerce-#endif  {-# ANN module "HLint: ignore Use on" #-} @@ -113,13 +124,15 @@ -- 'from' ('from' l) ≡ l -- @ from :: AnIso s t a b -> Iso b a t s-from l = case runIso l of-  Exchange sa bt -> iso bt sa+from l = withIso l $ \ sa bt -> iso bt sa {-# INLINE from #-} +-- | Extract the two functions, one from @s -> a@ and+-- one from @b -> t@ that characterize an 'Iso'. withIso :: AnIso s t a b -> ((s -> a) -> (b -> t) -> r) -> r-withIso l k = case runIso l of-  Exchange sa bt -> k sa bt+withIso ai k = case ai (Exchange id Mutator) of+  Exchange sa bt -> k sa (runMutator #. bt)+{-# INLINE withIso #-}  -- | Convert from 'AnIso' back to any 'Iso'. --@@ -128,26 +141,13 @@ -- -- See 'Control.Lens.Lens.cloneLens' or 'Control.Lens.Traversal.cloneTraversal' for more information on why you might want to do this. cloneIso :: AnIso s t a b -> Iso s t a b-cloneIso k = case runIso k of-  Exchange sa bt -> iso sa bt+cloneIso k = withIso k $ \ sa bt -> iso sa bt {-# INLINE cloneIso #-}  ----------------------------------------------------------------------------- -- Isomorphisms families as Lenses ----------------------------------------------------------------------------- --- | Extract the two functions, one from @s -> a@ and one from @b -> t@ that characterize--- an 'Iso'.-runIso :: AnIso s t a b -> Exchange a b s t-#ifdef SAFE-runIso ai = case ai (Exchange id Mutator) of-  Exchange sa bt -> Exchange sa (runMutator #. bt)-#else-runIso ai = unsafeCoerce $ ai $ Exchange id Mutator-#endif--{-# INLINE runIso #-}- -- | Based on 'Control.Lens.Wrapped.ala' from Conor McBride's work on Epigram. -- -- This version is generalized to accept any 'Iso', not just a @newtype@.@@ -155,8 +155,7 @@ -- >>> au (wrapping Sum) foldMap [1,2,3,4] -- 10 au :: AnIso s t a b -> ((s -> a) -> e -> b) -> e -> t-au k = case runIso k of-  Exchange sa bt -> \ f e -> bt (f sa e)+au k = withIso k $ \ sa bt f e -> bt (f sa e) {-# INLINE au #-}  -- | Based on @ala'@ from Conor McBride's work on Epigram.@@ -171,8 +170,7 @@ -- >>> auf (wrapping Sum) (foldMapOf both) Prelude.length ("hello","world") -- 10 auf :: AnIso s t a b -> ((r -> a) -> e -> b) -> (r -> s) -> e -> t-auf k = case runIso k of-  Exchange sa bt -> \ f g e -> bt (f (sa . g) e)+auf k = withIso k $ \ sa bt f g e -> bt (f (sa . g) e) {-# INLINE auf #-}  -- | The opposite of working 'Control.Lens.Setter.over' a 'Setter' is working 'under' an isomorphism.@@ -182,11 +180,10 @@ -- @ -- -- @--- 'under' :: 'Iso' s t a b -> (s -> t) -> a -> b+-- 'under' :: 'Iso' s t a b -> (t -> s) -> b -> a -- @ under :: AnIso s t a b -> (t -> s) -> b -> a-under k = case runIso k of-  Exchange sa bt -> \ts -> sa . ts . bt+under k = withIso k $ \ sa bt ts -> sa . ts . bt {-# INLINE under #-}  -----------------------------------------------------------------------------@@ -212,8 +209,7 @@  -- | This can be used to lift any 'Iso' into an arbitrary 'Functor'. mapping :: Functor f => AnIso s t a b -> Iso (f s) (f t) (f a) (f b)-mapping k = case runIso k of-  Exchange sa bt -> iso (fmap sa) (fmap bt)+mapping k = withIso k $ \ sa bt -> iso (fmap sa) (fmap bt) {-# INLINE mapping #-}  -- | Composition with this isomorphism is occasionally useful when your 'Lens',@@ -350,6 +346,44 @@   strict = iso LazyT.toStrict LazyT.fromStrict   {-# INLINE strict #-} +instance Strict (Lazy.StateT s m a) (Strict.StateT s m a) where+  strict = iso (Strict.StateT . Lazy.runStateT) (Lazy.StateT . Strict.runStateT)+  {-# INLINE strict #-}++instance Strict (Lazy.WriterT w m a) (Strict.WriterT w m a) where+  strict = iso (Strict.WriterT . Lazy.runWriterT) (Lazy.WriterT . Strict.runWriterT)+  {-# INLINE strict #-}++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 #-}+++-- | An 'Iso' between a list, 'ByteString', 'Text' fragment, etc. and its reversal.+--+-- >>> "live" ^. reversed+-- "evil"+--+-- >>> "live" & reversed %~ ('d':)+-- "lived"+reversed :: Reversing a => Iso' a a+reversed = involuted Iso.reversing++-- | Given a function that is its own inverse, this gives you an 'Iso' using it in both directions.+--+-- @+-- 'involuted' ≡ 'Control.Monad.join' 'iso'+-- @+--+-- >>> "live" ^. involuted reverse+-- "evil"+--+-- >>> "live" & involuted reverse %~ ('d':)+-- "lived"+involuted :: (a -> a) -> Iso' a a+involuted a = iso a a+{-# INLINE involuted #-}+ ------------------------------------------------------------------------------ -- Magma ------------------------------------------------------------------------------@@ -367,3 +401,52 @@ imagma :: Overloading (Indexed i) (->) (Molten i a b) s t a b -> Iso s t' (Magma i t b a) (Magma j t' c c) imagma l = iso (runMolten #. l sell) (iextract .# Molten) {-# INLINE imagma #-}++------------------------------------------------------------------------------+-- Contravariant+------------------------------------------------------------------------------++-- | Lift an 'Iso' into a 'Contravariant' functor.+--+-- @+-- contramapping :: 'Contravariant' f => 'Iso' s t a b -> 'Iso' (f a) (f b) (f s) (f t)+-- contramapping :: 'Contravariant' f => 'Iso'' s a -> 'Iso'' (f a) (f s)+-- @+contramapping :: Contravariant f => AnIso s t a b -> Iso (f a) (f b) (f s) (f t)+contramapping f = withIso f $ \ sa bt -> iso (contramap sa) (contramap bt)+{-# INLINE contramapping #-}++------------------------------------------------------------------------------+-- Profunctor+------------------------------------------------------------------------------++-- | Lift two 'Iso's into both arguments of a 'Profunctor' simultaneously.+--+-- @+-- dimapping :: 'Profunctor' p => 'Iso' s t a b -> 'Iso' s' t' a' b' -> 'Iso' (p a s') (p b t') (p s a') (p t b')+-- dimapping :: 'Profunctor' p => 'Iso'' s a -> 'Iso'' s' a' -> 'Iso'' (p a s') (p s a')+-- @+dimapping :: Profunctor p => AnIso s t a b -> AnIso s' t' a' b' -> Iso (p a s') (p b t') (p s a') (p t b')+dimapping f g = withIso f $ \ s'a' b't' -> withIso g $ \ sa bt ->+  iso (dimap s'a' sa) (dimap b't' bt)+{-# INLINE dimapping #-}++-- | Lift an 'Iso' contravariantly into the left argument of a 'Profunctor'.+--+-- @+-- lmapping :: 'Profunctor' p => 'Iso' s t a b -> 'Iso' (p a x) (p b y) (p s x) (p t y)+-- lmapping :: 'Profunctor' p => 'Iso'' s a -> 'Iso'' (p a x) (p s x)+-- @+lmapping :: Profunctor p => AnIso s t a b -> Iso (p a x) (p b y) (p s x) (p t y)+lmapping f = withIso f $ \ sa bt -> iso (lmap sa) (lmap bt)+{-# INLINE lmapping #-}++-- | Lift an 'Iso' covariantly into the right argument of a 'Profunctor'.+--+-- @+-- rmapping :: 'Profunctor' p => 'Iso' s t a b -> 'Iso' (p x s) (p y t) (p x a) (p y b)+-- rmapping :: 'Profunctor' p => 'Iso'' s a -> 'Iso'' (p x s) (p x a)+-- @+rmapping :: Profunctor p => AnIso s t a b -> Iso (p x s) (p y t) (p x a) (p y b)+rmapping g = withIso g $ \ sa bt -> iso (rmap sa) (rmap bt)+{-# INLINE rmapping #-}

@@ -71,6 +71,7 @@   , (%%~), (%%=)   , (%%@~), (%%@=)   , (<%@~), (<%@=)+  , (<<%@~), (<<%@=)    -- * Lateral Composition   , choosing@@ -139,8 +140,8 @@ -- >>> let setter :: Expr -> Expr -> Expr; setter = fun "setter"  infixl 8 ^#-infixr 4 %%@~, <%@~, %%~, <+~, <*~, <-~, <//~, <^~, <^^~, <**~, <&&~, <||~, <<>~, <%~, <<%~, <<.~, <#~, #~, #%~, <#%~, #%%~-infix  4 %%@=, <%@=, %%=, <+=, <*=, <-=, <//=, <^=, <^^=, <**=, <&&=, <||=, <<>=, <%=, <<%=, <<.=, <#=, #=, #%=, <#%=, #%%=+infixr 4 %%@~, <%@~, <<%@~, %%~, <+~, <*~, <-~, <//~, <^~, <^^~, <**~, <&&~, <||~, <<>~, <%~, <<%~, <<.~, <#~, #~, #%~, <#%~, #%%~+infix  4 %%@=, <%@=, <<%@=, %%=, <+=, <*=, <-=, <//=, <^=, <^^=, <**=, <&&=, <||=, <<>=, <%=, <<%=, <<.=, <#=, #=, #%=, <#%=, #%%= infixr 2 <<~  -------------------------------------------------------------------------------@@ -367,8 +368,8 @@ -- -- @ -- 'locus' :: 'Lens'' ('Context'' a s) a--- 'locus' :: 'Lens'' ('Pretext'' p a s) a--- 'locus' :: 'Lens'' ('PretextT'' p g a s) a+-- 'locus' :: 'Conjoined' p => 'Lens'' ('Pretext'' p a s) a+-- 'locus' :: 'Conjoined' p => 'Lens'' ('PretextT'' p g a s) a -- @ locus :: IndexedComonadStore p => Lens (p a c s) (p b c s) a b locus f w = (`iseek` w) <$> f (ipos w)@@ -448,8 +449,8 @@ -- flexible. -- -- @--- ('<*~') :: 'Num' b => 'Lens'' s a -> a -> a -> (s, a)--- ('<*~') :: 'Num' b => 'Control.Lens.Iso.Iso''  s a -> a -> a -> (s, a)+-- ('<*~') :: 'Num' a => 'Lens'' s a -> a -> s -> (a, s)+-- ('<*~') :: 'Num' a => 'Control.Lens.Iso.Iso''  s a -> a -> s -> (a, s) -- @ (<*~) :: Num a => Overloading (->) q ((,)a) s t a a -> a -> q s (a, t) l <*~ a = l <%~ (* a)@@ -460,8 +461,8 @@ -- When you do not need the result of the division, ('Control.Lens.Setter.//~') is more flexible. -- -- @--- ('<//~') :: 'Fractional' b => 'Lens'' s a -> a -> a -> (s, a)--- ('<//~') :: 'Fractional' b => 'Control.Lens.Iso.Iso''  s a -> a -> a -> (s, a)+-- ('<//~') :: 'Fractional' a => 'Lens'' s a -> a -> s -> (a, s)+-- ('<//~') :: 'Fractional' a => 'Control.Lens.Iso.Iso''  s a -> a -> s -> (a, s) -- @ (<//~) :: Fractional a => Overloading (->) q ((,)a) s t a a -> a -> q s (a, t) l <//~ a = l <%~ (/ a)@@ -473,8 +474,8 @@ -- When you do not need the result of the division, ('Control.Lens.Setter.^~') is more flexible. -- -- @--- ('<^~') :: ('Num' b, 'Integral' e) => 'Lens'' s a -> e -> a -> (a, s)--- ('<^~') :: ('Num' b, 'Integral' e) => 'Control.Lens.Iso.Iso'' s a -> e -> a -> (a, s)+-- ('<^~') :: ('Num' a, 'Integral' e) => 'Lens'' s a -> e -> s -> (a, s)+-- ('<^~') :: ('Num' a, 'Integral' e) => 'Control.Lens.Iso.Iso'' s a -> e -> s -> (a, s) -- @ (<^~) :: (Num a, Integral e) => Overloading (->) q ((,)a) s t a a -> e -> q s (a, t) l <^~ e = l <%~ (^ e)@@ -486,8 +487,8 @@ -- When you do not need the result of the division, ('Control.Lens.Setter.^^~') is more flexible. -- -- @--- ('<^^~') :: ('Fractional' b, 'Integral' e) => 'Lens'' s a -> e -> a -> (a, s)--- ('<^^~') :: ('Fractional' b, 'Integral' e) => 'Control.Lens.Iso.Iso'' s a -> e -> a -> (a, s)+-- ('<^^~') :: ('Fractional' a, 'Integral' e) => 'Lens'' s a -> e -> s -> (a, s)+-- ('<^^~') :: ('Fractional' a, 'Integral' e) => 'Control.Lens.Iso.Iso'' s a -> e -> s -> (a, s) -- @ (<^^~) :: (Fractional a, Integral e) => Overloading (->) q ((,)a) s t a a -> e -> q s (a, t) l <^^~ e = l <%~ (^^ e)@@ -535,9 +536,9 @@ -- When you do not need the result of the addition, ('Control.Lens.Setter.%~') is more flexible. -- -- @--- ('<<%~') ::             'Lens' s t a b      -> (a -> b) -> s -> (b, t)--- ('<<%~') ::             'Control.Lens.Iso.Iso' s t a b       -> (a -> b) -> s -> (b, t)--- ('<<%~') :: 'Monoid' b => 'Control.Lens.Traversal.Traversal' s t a b -> (a -> b) -> s -> (b, t)+-- ('<<%~') ::             'Lens' s t a b      -> (a -> b) -> s -> (a, t)+-- ('<<%~') ::             'Control.Lens.Iso.Iso' s t a b       -> (a -> b) -> s -> (a, t)+-- ('<<%~') :: 'Monoid' a => 'Control.Lens.Traversal.Traversal' s t a b -> (a -> b) -> s -> (a, t) -- @ (<<%~) :: Strong p => Overloading p q ((,)a) s t a b -> p a b -> q s (a, t) (<<%~) l = l . lmap (\a -> (a, a)) . second'@@ -548,9 +549,9 @@ -- When you do not need the old value, ('Control.Lens.Setter.%~') is more flexible. -- -- @--- ('<<%~') ::             'Lens' s t a b      -> b -> s -> (a, t)--- ('<<%~') ::             'Control.Lens.Iso.Iso' s t a b       -> b -> s -> (a, t)--- ('<<%~') :: 'Monoid' b => 'Control.Lens.Traversal.Traversal' s t a b -> b -> s -> (a, t)+-- ('<<.~') ::             'Lens' s t a b      -> b -> s -> (a, t)+-- ('<<.~') ::             'Control.Lens.Iso.Iso' s t a b       -> b -> s -> (a, t)+-- ('<<.~') :: 'Monoid' a => 'Control.Lens.Traversal.Traversal' s t a b -> b -> s -> (a, t) -- @ (<<.~) :: Overloading (->) q ((,)a) s t a b -> b -> q s (a, t) l <<.~ b = l $ \a -> (a, b)@@ -788,6 +789,19 @@ l <%@~ f = l (Indexed $ \i a -> let b = f i a in (b, b)) {-# INLINE (<%@~) #-} +-- | Adjust the target of an 'IndexedLens' returning the old value, or+-- adjust all of the targets of an 'Control.Lens.Traversal.IndexedTraversal' and return a monoidal summary+-- of the old values along with the answer.+--+-- @+-- ('<<%@~') ::             'IndexedLens' i s t a b      -> (i -> a -> b) -> s -> (a, t)+-- ('<<%@~') :: 'Monoid' a => 'Control.Lens.Traversal.IndexedTraversal' i s t a b -> (i -> a -> b) -> s -> (a, t)+-- @+(<<%@~) :: Overloading (Indexed i) q ((,) a) s t a b -> (i -> a -> b) -> q s (a, t)+l <<%@~ f = l $ Indexed $ \i a -> second' (f i) (a,a)++{-# INLINE (<<%@~) #-}+ -- | Adjust the target of an 'IndexedLens' returning a supplementary result, or -- adjust all of the targets of an 'Control.Lens.Traversal.IndexedTraversal' and return a monoidal summary -- of the supplementary results and the answer.@@ -796,7 +810,7 @@ -- -- @ -- ('%%@~') :: 'Functor' f => 'IndexedLens' i s t a b      -> (i -> a -> f b) -> s -> f t--- ('%%@~') :: 'Functor' f => 'Control.Lens.Traversal.IndexedTraversal' i s t a b -> (i -> a -> f b) -> s -> f t+-- ('%%@~') :: 'Applicative' f => 'Control.Lens.Traversal.IndexedTraversal' i s t a b -> (i -> a -> f b) -> s -> f t -- @ -- -- In particular, it is often useful to think of this function as having one of these even more@@ -817,7 +831,7 @@ -- @l '%%@=' f ≡ 'state' (l '%%@~' f)@ -- -- @--- ('%%@=') :: 'MonadState' s m                'IndexedLens' i s s a b      -> (i -> a -> (r, b)) -> s -> m r+-- ('%%@=') :: 'MonadState' s m                 => 'IndexedLens' i s s a b      -> (i -> a -> (r, b)) -> s -> m r -- ('%%@=') :: ('MonadState' s m, 'Monoid' r) => 'Control.Lens.Traversal.IndexedTraversal' i s s a b -> (i -> a -> (r, b)) -> s -> m r -- @ (%%@=) :: MonadState s m => IndexedLensLike i ((,) r) s s a b -> (i -> a -> (r, b)) -> m r@@ -836,13 +850,32 @@ -- return a monoidal summary of the intermediate results. -- -- @--- ('<%@=') :: 'MonadState' s m                'IndexedLens' i s s a b      -> (i -> a -> b) -> m b+-- ('<%@=') :: 'MonadState' s m                 => 'IndexedLens' i s s a b      -> (i -> a -> b) -> m b -- ('<%@=') :: ('MonadState' s m, 'Monoid' b) => 'Control.Lens.Traversal.IndexedTraversal' i s s a b -> (i -> a -> b) -> m b -- @ (<%@=) :: MonadState s m => IndexedLensLike i ((,) b) s s a b -> (i -> a -> b) -> m b l <%@= f = l %%@= \ i a -> let b = f i a in (b, b) {-# INLINE (<%@=) #-} +-- | Adjust the target of an 'IndexedLens' returning the old value, or+-- adjust all of the targets of an 'Control.Lens.Traversal.IndexedTraversal' within the current state, and+-- return a monoidal summary of the old values.+--+-- @+-- ('<<%@=') :: 'MonadState' s m                 => 'IndexedLens' i s s a b      -> (i -> a -> b) -> m a+-- ('<<%@=') :: ('MonadState' s m, 'Monoid' b) => 'Control.Lens.Traversal.IndexedTraversal' i s s a b -> (i -> a -> b) -> m a+-- @+(<<%@=) :: MonadState s m => IndexedLensLike i ((,) a) s s a b -> (i -> a -> b) -> m a+#if MIN_VERSION_mtl(2,1,0)+l <<%@= f = State.state (l (Indexed $ \ i a -> (a, f i a)))+#else+l <<%@= f = do+  (r, s) <- State.gets (l (Indexed $ \ i a -> (a, f i a)))+  State.put s+  return r+#endif+{-# INLINE (<<%@=) #-}+ ------------------------------------------------------------------------------ -- ALens Combinators ------------------------------------------------------------------------------@@ -943,7 +976,7 @@ -- >>> [] & mapped.devoid +~ 1 -- [] ----- Nothing & mapped.devoid %~ abs+-- >>> Nothing & mapped.devoid %~ abs -- Nothing -- -- @

@@ -1,4 +1,3 @@-{-# LANGUAGE Rank2Types #-} ------------------------------------------------------------------------------- -- | -- Module      :  Control.Lens.Loupe

@@ -56,6 +56,7 @@   -- *** with Indices   , (%@~), (%@=)   , (<%@~), (<%@=)+  , (<<%@~), (<<%@=)    -- ** Traversing   , (%%~), (%%=)

@@ -104,7 +104,7 @@ -- @ -- import Control.Applicative -- import Control.Lens--- import Control.Plated+-- import Control.Lens.Plated -- import Data.Data -- import Data.Data.Lens ('Data.Data.Lens.uniplate') -- @@@ -136,7 +136,7 @@ -- @ -- import Control.Applicative -- import Control.Lens--- import Control.Plated+-- import Control.Lens.Plated -- import Data.Data -- import Data.Data.Lens ('Data.Data.Lens.uniplate') -- @@@ -330,13 +330,13 @@ -- @ -- 'universeOf' :: 'Fold' a a -> a -> [a] -- @-universeOf :: Getting [a] a b a b -> a -> [a]+universeOf :: Getting [a] a a -> a -> [a] universeOf l = go where   go a = a : foldMapOf l go a {-# INLINE universeOf #-}  -- | Given a 'Fold' that knows how to find 'Plated' parts of a container retrieve them and all of their descendants, recursively.-universeOn ::  Plated a => Getting [a] s t a a -> s -> [a]+universeOn ::  Plated a => Getting [a] s a -> s -> [a] universeOn b = universeOnOf b plate {-# INLINE universeOn #-} @@ -346,7 +346,7 @@ -- @ -- 'toListOf' l ≡ 'universeOnOf' l 'ignored' -- @-universeOnOf :: Getting [a] s t a b -> Getting [a] a b a b -> s -> [a]+universeOnOf :: Getting [a] s a -> Getting [a] a a -> s -> [a] universeOnOf b = foldMapOf b . universeOf {-# INLINE universeOnOf #-} @@ -429,7 +429,7 @@ -- @ -- 'transformMOnOf' :: 'Monad' m => 'Traversal'' s a -> 'Traversal'' a a -> (a -> m a) -> s -> m s -- @-transformMOnOf :: Monad m => LensLike (WrappedMonad m) s a a a -> LensLike' (WrappedMonad m) a a -> (a -> m a) -> s -> m a+transformMOnOf :: Monad m => LensLike (WrappedMonad m) s t a a -> LensLike' (WrappedMonad m) a a -> (a -> m a) -> s -> m t transformMOnOf b l = mapMOf b . transformMOf l {-# INLINE transformMOnOf #-} @@ -459,7 +459,7 @@ -- @ -- -- @--- 'contextsOf' :: 'Traversal'' a a -> a -> ['Context' a a]+-- 'contextsOf' :: 'Traversal'' a a -> a -> ['Context' a a a] -- @ contextsOf :: ATraversal' a a -> a -> [Context a a a] contextsOf l x = sell x : f (map context (holesOf l x)) where@@ -558,7 +558,7 @@ -- @ -- 'paraOf' :: 'Fold' a a -> (a -> [r] -> r) -> a -> r -- @-paraOf :: Getting (Endo [a]) a b a b -> (a -> [r] -> r) -> a -> r+paraOf :: Getting (Endo [a]) a a -> (a -> [r] -> r) -> a -> r paraOf l f = go where   go a = f a (go <$> toListOf l a) {-# INLINE paraOf #-}

@@ -51,6 +51,8 @@ import Unsafe.Coerce #endif +{-# ANN module "HLint: ignore Use camelCase" #-}+ -- $setup -- >>> :set -XNoOverloadedStrings -- >>> import Control.Lens@@ -267,3 +269,4 @@ -- Nothing only :: Eq a => a -> Prism' a () only a = prism' (\() -> a) $ guard . (a ==)+{-# INLINE only #-}

@@ -25,8 +25,9 @@   , review, reviews   , reuse, reuses   , ( # )-  -- * Reviewable Profunctors-  , Reviewable(..)+  , Bifunctor(bimap)+  , retagged+  , Reviewable   ) where  import Control.Monad.Reader as Reader@@ -35,9 +36,11 @@ import Control.Lens.Internal.Review import Control.Lens.Internal.Setter import Control.Lens.Type+import Data.Bifunctor import Data.Functor.Identity import Data.Profunctor import Data.Profunctor.Unsafe+import Data.Void  -- $setup -- >>> :set -XNoOverloadedStrings@@ -46,7 +49,7 @@ -- >>> let isLeft  (Left  _) = True; isLeft  _ = False -- >>> let isRight (Right _) = True; isRight _ = False -infixr 9 #+infixr 8 #  ------------------------------------------------------------------------------ -- Review@@ -58,7 +61,7 @@ -- -- You can generate a 'Review' by using 'unto'. You can also use any 'Prism' or 'Iso' -- directly as a 'Review'.-type Review s t a b = forall p f. (Reviewable p, Settable f) => Overloaded p f s t a b+type Review s t a b = forall p f. (Profunctor p, Bifunctor p, Settable f) => Overloaded p f s t a b  -- | A 'Simple' 'Review' type Review' t b = Review t t b b@@ -75,8 +78,9 @@ -- @ -- 'unto' :: (b -> t) -> 'Review'' t b -- @-unto :: (Reviewable p, Functor f) => (b -> t) -> Overloaded p f s t a b-unto f = retagged . rmap (fmap f)+unto :: (Profunctor p, Bifunctor p, Functor f) => (b -> t) -> Overloaded p f s t a b+unto f = first absurd . lmap absurd . rmap (fmap f)+{-# INLINE unto #-}  -- | Turn a 'Prism' or 'Control.Lens.Iso.Iso' around to build a 'Getter'. --

@@ -790,7 +790,7 @@     prefix ('_':xs) | '_' `List.elem` xs = Just (takeWhile (/= '_') xs)     prefix _                             = Nothing     rawLens     x = x ++ "_lens"-    niceLens    x = prefix   x <&> \n -> drop (length n + 2) n+    niceLens    x = prefix   x <&> \n -> drop (length n + 2) x     classNaming x = niceLens x <&> ("Has_" ++)  -- | Field rules for fields in the form @ prefixFieldname @@@ -805,12 +805,35 @@     niceLens    x = overHead toLower . snd <$> sep x     classNaming x = niceLens x <&> \ (n:ns) -> "Has" ++ toUpper n : ns +collectRecords :: [Con] -> [VarStrictType]+collectRecords cons = rs+  where+    recs = filter (\r -> case r of RecC{} -> True; _ -> False) cons+    rs' = List.concatMap (\(RecC _ _rs) -> _rs) recs+    rs = nubBy ((==) `on` (^._1)) rs'+ verboseLenses :: FieldRules -> Name -> Q [Dec] verboseLenses c src = do-    TyConI (DataD _ _ _ [RecC _ rs] _) <- reify src-    flip makeLensesFor src+    rs <- do+        inf <- reify src+        case inf of+          TyConI decl -> case deNewtype decl of+            DataD _ _ _ cons _ -> do+              let rs = collectRecords cons+              if List.null rs+                then fail "verboseLenses: Expected the name of a record type"+                else return rs+            _ -> fail "verboseLenses: Unsupported data type"+          _ -> fail "verboseLenses: Expected the name of a data type or newtype"+    flip makeLenses' src         $ mkFields c rs         & map (\(Field n _ l _ _) -> (show n, show l))+  where+    makeLenses' fields' =+        makeLensesWith $ lensRules+            & lensField .~ (`Prelude.lookup` fields')+            & buildTraversals .~ False+            & partialLenses .~ True  mkFields :: FieldRules -> [VarStrictType] -> [Field] mkFields (FieldRules prefix' raw' nice' clas') rs@@ -832,7 +855,17 @@ hasClassAndInstance cfg src = do     c <- newName "c"     e <- newName "e"-    TyConI (DataD _ _ vs [RecC _ rs] _) <- reify src+    (vs,rs) <- do+        inf <- reify src+        case inf of+          TyConI decl -> case deNewtype decl of+            DataD _ _ vs cons _ -> do+                let rs = collectRecords cons+                if List.null rs+                  then fail "hasClassAndInstance: Expected the name of a record type"+                  else return (vs,rs)+            _ -> fail "hasClassAndInstance: Unsupported data type"+          _ -> fail "hasClassAndInstance: Expected the name of a data type or newtype"     fmap concat . forM (mkFields cfg rs) $ \(Field field _ fullLensName className lensName) -> do         classHas <- classD             (return [])

@@ -59,6 +59,7 @@   , transposeOf   , mapAccumLOf, mapAccumROf   , scanr1Of, scanl1Of+  , failover    -- * Monomorphic Traversals   , cloneTraversal@@ -107,16 +108,19 @@   , Bazaar(..)   , Bazaar'   , loci+  , iloci   ) where  import Control.Applicative as Applicative import Control.Applicative.Backwards import Control.Category import Control.Comonad+import Control.Monad import Control.Lens.Combinators import Control.Lens.Fold-import Control.Lens.Internal.Context+import Control.Lens.Getter (coerced) import Control.Lens.Internal.Bazaar+import Control.Lens.Internal.Context import Control.Lens.Internal.Indexed import Control.Lens.Type import Control.Monad.Trans.State.Lazy@@ -124,6 +128,7 @@ import Data.Int import Data.IntMap as IntMap import Data.Map as Map+import Data.Monoid import Data.Traversable import Data.Tuple (swap) import Data.Profunctor@@ -137,6 +142,7 @@ -- >>> import Control.DeepSeq (NFData (..), force) -- >>> import Control.Exception (evaluate) -- >>> import Data.Maybe (fromMaybe)+-- >>> import Data.Void -- >>> import System.Timeout (timeout) -- >>> let timingOut :: NFData a => a -> IO a; timingOut = fmap (fromMaybe (error "timeout")) . timeout (5*10^6) . evaluate . force @@ -208,9 +214,9 @@ -- @ -- -- @--- 'traverseOf' :: 'Iso' s t a b       -> (a -> f b) -> s -> f t--- 'traverseOf' :: 'Lens' s t a b      -> (a -> f b) -> s -> f t--- 'traverseOf' :: 'Traversal' s t a b -> (a -> f b) -> s -> f t+-- 'traverseOf' :: 'Functor' f => 'Iso' s t a b       -> (a -> f b) -> s -> f t+-- 'traverseOf' :: 'Functor' f => 'Lens' s t a b      -> (a -> f b) -> s -> f t+-- 'traverseOf' :: 'Applicative' f => 'Traversal' s t a b -> (a -> f b) -> s -> f t -- @ traverseOf :: Over p f s t a b -> p a (f b) -> s -> f t traverseOf = id@@ -237,9 +243,9 @@ -- @ -- -- @--- 'forOf' :: 'Iso' s t a b -> s -> (a -> f b) -> f t--- 'forOf' :: 'Lens' s t a b -> s -> (a -> f b) -> f t--- 'forOf' :: 'Traversal' s t a b -> s -> (a -> f b) -> f t+-- 'forOf' :: 'Functor' f => 'Iso' s t a b -> s -> (a -> f b) -> f t+-- 'forOf' :: 'Functor' f => 'Lens' s t a b -> s -> (a -> f b) -> f t+-- 'forOf' :: 'Applicative' f => 'Traversal' s t a b -> s -> (a -> f b) -> f t -- @ forOf :: Over p f s t a b -> s -> p a (f b) -> f t forOf = flip@@ -257,8 +263,8 @@ -- @ -- -- @--- 'sequenceAOf' ::                  'Iso' s t (f b) b       -> s -> f t--- 'sequenceAOf' ::                  'Lens' s t (f b) b      -> s -> f t+-- 'sequenceAOf' :: 'Functor' f => 'Iso' s t (f b) b       -> s -> f t+-- 'sequenceAOf' :: 'Functor' f => 'Lens' s t (f b) b      -> s -> f t -- 'sequenceAOf' :: 'Applicative' f => 'Traversal' s t (f b) b -> s -> f t -- @ sequenceAOf :: LensLike f s t (f b) b -> s -> f t@@ -277,8 +283,8 @@ -- @ -- -- @--- 'mapMOf' ::            'Iso' s t a b       -> (a -> m b) -> s -> m t--- 'mapMOf' ::            'Lens' s t a b      -> (a -> m b) -> s -> m t+-- 'mapMOf' :: 'Monad' m => 'Iso' s t a b       -> (a -> m b) -> s -> m t+-- 'mapMOf' :: 'Monad' m => 'Lens' s t a b      -> (a -> m b) -> s -> m t -- 'mapMOf' :: 'Monad' m => 'Traversal' s t a b -> (a -> m b) -> s -> m t -- @ mapMOf :: Profunctor p => Over p (WrappedMonad m) s t a b -> p a (m b) -> s -> m t@@ -297,8 +303,8 @@ -- @ -- -- @--- 'forMOf' ::            'Iso' s t a b       -> s -> (a -> m b) -> m t--- 'forMOf' ::            'Lens' s t a b      -> s -> (a -> m b) -> m t+-- 'forMOf' :: 'Monad' m => 'Iso' s t a b       -> s -> (a -> m b) -> m t+-- 'forMOf' :: 'Monad' m => 'Lens' s t a b      -> s -> (a -> m b) -> m t -- 'forMOf' :: 'Monad' m => 'Traversal' s t a b -> s -> (a -> m b) -> m t -- @ forMOf :: Profunctor p => Over p (WrappedMonad m) s t a b -> s -> p a (m b) -> m t@@ -317,8 +323,8 @@ -- @ -- -- @--- 'sequenceOf' ::            'Iso' s t (m b) b       -> s -> m t--- 'sequenceOf' ::            'Lens' s t (m b) b      -> s -> m t+-- 'sequenceOf' :: 'Monad' m => 'Iso' s t (m b) b       -> s -> m t+-- 'sequenceOf' :: 'Monad' m => 'Lens' s t (m b) b      -> s -> m t -- 'sequenceOf' :: 'Monad' m => 'Traversal' s t (m b) b -> s -> m t -- @ sequenceOf :: LensLike (WrappedMonad m) s t (m b) b -> s -> m t@@ -431,6 +437,12 @@ loci f w = getCompose (runBazaar w (Compose #. fmap sell . f)) {-# INLINE loci #-} +-- | This 'IndexedTraversal' allows you to 'traverse' the individual stores in+-- a 'Bazaar' with access to their indices.+iloci :: IndexedTraversal i (Bazaar (Indexed i) a c s) (Bazaar (Indexed i) b c s) a b+iloci f w = getCompose (runBazaar w (Compose #. Indexed (\i -> fmap (indexed sell i) . indexed f i)))+{-# INLINE iloci #-}+ ------------------------------------------------------------------------------- -- Parts and Holes -------------------------------------------------------------------------------@@ -592,7 +604,7 @@ ------------------------------------------------------------------------------  ins :: Bizarre (->) w => w a b t -> [a]-ins = toListOf bazaar+ins = toListOf (coerced bazaar) {-# INLINE ins #-}  pins :: (Bizarre p w, Corepresentable p) => w a b t -> [Corep p a]@@ -641,7 +653,7 @@ -- 'beside' :: 'Traversal' s t a b                -> 'Traversal' s' t' a b                -> 'Traversal' (s,s') (t,t') a b -- 'beside' :: 'Lens' s t a b                     -> 'Lens' s' t' a b                     -> 'Traversal' (s,s') (t,t') a b -- 'beside' :: 'Fold' s a                         -> 'Fold' s' a                          -> 'Fold' (s,s') a--- 'beside' :: 'Getter' s a                       -> 'Getter' s' a                        -> 'Traversal' (s,s') a+-- 'beside' :: 'Getter' s a                       -> 'Getter' s' a                        -> 'Fold' (s,s') a -- 'beside' :: 'Action' m s a                     -> 'Action' m s' a                      -> 'MonadicFold' m (s,s') a -- 'beside' :: 'MonadicFold' m s a                -> 'MonadicFold' m s' a                 -> 'MonadicFold' m (s,s') a -- @@@ -650,7 +662,7 @@ -- 'beside' :: 'IndexedTraversal' i s t a b       -> 'IndexedTraversal' i s' t' a b       -> 'IndexedTraversal' i (s,s') (t,t') a b -- 'beside' :: 'IndexedLens' i s t a b            -> 'IndexedLens' i s' t' a b            -> 'IndexedTraversal' i (s,s') (t,t') a b -- 'beside' :: 'IndexedFold' i s a                -> 'IndexedFold' i s' a                 -> 'IndexedFold' i (s,s') a--- 'beside' :: 'IndexedGetter' i s a              -> 'IndexedGetter' i s' a               -> 'IndexedTraversal' i (s,s') a+-- 'beside' :: 'IndexedGetter' i s a              -> 'IndexedGetter' i s' a               -> 'IndexedFold' i (s,s') a -- 'beside' :: 'IndexedAction' i m s a            -> 'IndexedAction' i m s' a             -> 'IndexedMonadicFold' i m (s,s') a -- 'beside' :: 'IndexedMonadicFold' i m s a       -> 'IndexedMonadicFold' i m s' a        -> 'IndexedMonadicFold' i m (s,s') a -- @@@ -659,7 +671,7 @@ -- 'beside' :: 'IndexPreservingTraversal' s t a b -> 'IndexPreservingTraversal' s' t' a b -> 'IndexPreservingTraversal' (s,s') (t,t') a b -- 'beside' :: 'IndexPreservingLens' s t a b      -> 'IndexPreservingLens' s' t' a b      -> 'IndexPreservingTraversal' (s,s') (t,t') a b -- 'beside' :: 'IndexPreservingFold' s a          -> 'IndexPreservingFold' s' a           -> 'IndexPreservingFold' (s,s') a--- 'beside' :: 'IndexPreservingGetter' s a        -> 'IndexPreservingGetter' s' a         -> 'IndexPreservingTraversal' (s,s') a+-- 'beside' :: 'IndexPreservingGetter' s a        -> 'IndexPreservingGetter' s' a         -> 'IndexPreservingFold' (s,s') a -- 'beside' :: 'IndexPreservingAction' m s a      -> 'IndexPreservingAction' m s' a       -> 'IndexPreservingMonadicFold' m (s,s') a -- 'beside' :: 'IndexPreservingMonadicFold' m s a -> 'IndexPreservingMonadicFold' m s' a  -> 'IndexPreservingMonadicFold' m (s,s') a -- @@@ -756,12 +768,12 @@ -- former can execute at full speed, while the latter needs to round trip through -- the 'Bazaar'. ----- >>> let foo l a = (view (cloneTraversal l) a, set (cloneTraversal l) 10 a)+-- >>> let foo l a = (view (coerced (cloneTraversal l)) a, set (cloneTraversal l) 10 a) -- >>> foo both ("hello","world") -- ("helloworld",(10,10)) -- -- @--- 'cloneTraversal' :: 'LensLike' ('Bazaar' a b) s t a b -> 'Traversal' s t a b+-- 'cloneTraversal' :: 'LensLike' ('Bazaar' (->) a b) s t a b -> 'Traversal' s t a b -- @ cloneTraversal :: ATraversal s t a b -> Traversal s t a b cloneTraversal l f = bazaar f . l sell@@ -793,8 +805,8 @@ -- @ -- -- @--- 'itraverseOf' :: 'IndexedLens' i s t a b      -> (i -> a -> f b) -> s -> f t--- 'itraverseOf' :: 'IndexedTraversal' i s t a b -> (i -> a -> f b) -> s -> f t+-- 'itraverseOf' :: 'Functor' f     => 'IndexedLens' i s t a b      -> (i -> a -> f b) -> s -> f t+-- 'itraverseOf' :: 'Applicative' f => 'IndexedTraversal' i s t a b -> (i -> a -> f b) -> s -> f t -- @ itraverseOf :: (Indexed i a (f b) -> s -> f t) -> (i -> a -> f b) -> s -> f t itraverseOf l = l .# Indexed@@ -808,8 +820,8 @@ -- @ -- -- @--- 'iforOf' :: 'IndexedLens' i s t a b      -> s -> (i -> a -> f b) -> f t--- 'iforOf' :: 'IndexedTraversal' i s t a b -> s -> (i -> a -> f b) -> f t+-- 'iforOf' :: 'Functor' f => 'IndexedLens' i s t a b      -> s -> (i -> a -> f b) -> f t+-- 'iforOf' :: 'Applicative' f => 'IndexedTraversal' i s t a b -> s -> (i -> a -> f b) -> f t -- @ iforOf :: (Indexed i a (f b) -> s -> f t) -> s -> (i -> a -> f b) -> f t iforOf = flip . itraverseOf@@ -905,6 +917,9 @@ -- @ -- 'ignored' ≡ 'const' 'pure' -- @+--+-- >>> 6 & ignored %~ absurd+-- 6 ignored :: Applicative f => pafb -> s -> f s ignored _ = pure {-# INLINE ignored #-}@@ -1007,3 +1022,19 @@ elements :: Traversable t => (Int -> Bool) -> IndexedTraversal' Int (t a) a elements = elementsOf traverse {-# INLINE elements #-}++-- | Try to map a function over this 'Traversal', failing if the 'Traversal' has no targets.+--+-- >>> failover (element 3) (*2) [1,2] :: Maybe [Int]+-- Nothing+--+-- >>> failover _Left (*2) (Right 4) :: Maybe (Either Int Int)+-- Nothing+--+-- >>> failover _Right (*2) (Right 4) :: Maybe (Either Int Int)+-- Just (Right 8)+failover :: MonadPlus m => LensLike ((,) Any) s t a b -> (a -> b) -> s -> m t+failover l f s = case l ((,) (Any True) . f) s of+  (Any True, t)  -> return t+  (Any False, _) -> mzero+{-# INLINE failover #-}

@@ -70,7 +70,7 @@   -- '_1' :: 'Lens' (a,b,c) (a',b,c) a a'   -- '_1' :: 'Lens' (a,b,c,d) (a',b,c,d) a a'   -- ...-  -- '_1' :: 'Lens' (a,c,d,e,f,g,h,i) (a',b,c,d,e,f,g,h,i) a a'+  -- '_1' :: 'Lens' (a,b,c,d,e,f,g,h,i) (a',b,c,d,e,f,g,h,i) a a'   -- @   _1 :: IndexedLens Int s t a b 

@@ -54,9 +54,9 @@  import Control.Applicative import Control.Lens.Internal.Action-import Control.Lens.Internal.Getter import Control.Lens.Internal.Setter import Control.Lens.Internal.Indexed+import Data.Functor.Contravariant import Data.Profunctor  -- $setup@@ -409,14 +409,14 @@ -- -- Moreover, a 'Getter' can be used directly as a 'Control.Lens.Fold.Fold', -- since it just ignores the 'Applicative'.-type Getter s a = forall f. Gettable f => (a -> f a) -> s -> f s+type Getter s a = forall f. (Contravariant f, Functor f) => (a -> f a) -> s -> f s  -- | Every 'IndexedGetter' is a valid 'Control.Lens.Fold.IndexedFold' and can be used for 'Control.Lens.Getter.Getting' like a 'Getter'.-type IndexedGetter i s a = forall p f. (Indexable i p, Gettable f) => p a (f a) -> s -> f s+type IndexedGetter i s a = forall p f. (Indexable i p, Contravariant f, Functor f) => p a (f a) -> s -> f s  -- | An 'IndexPreservingGetter' can be used as a 'Getter', but when composed with an 'IndexedTraversal', -- 'IndexedFold', or 'IndexedLens' yields an 'IndexedFold', 'IndexedFold' or 'IndexedGetter' respectively.-type IndexPreservingGetter s a = forall p f. (Conjoined p, Gettable f) => p a (f a) -> p s (f s)+type IndexPreservingGetter s a = forall p f. (Conjoined p, Contravariant f, Functor f) => p a (f a) -> p s (f s)  -------------------------- -- Folds@@ -435,14 +435,14 @@ -- -- Unlike a 'Control.Lens.Traversal.Traversal' a 'Fold' is read-only. Since a 'Fold' cannot be used to write back -- there are no 'Lens' laws that apply.-type Fold s a = forall f. (Gettable f, Applicative f) => (a -> f a) -> s -> f s+type Fold s a = forall f. (Contravariant f, Applicative f) => (a -> f a) -> s -> f s  -- | Every 'IndexedFold' is a valid 'Control.Lens.Fold.Fold' and can be used for 'Control.Lens.Getter.Getting'.-type IndexedFold i s a = forall p f.  (Indexable i p, Applicative f, Gettable f) => p a (f a) -> s -> f s+type IndexedFold i s a = forall p f.  (Indexable i p, Contravariant f, Applicative f) => p a (f a) -> s -> f s  -- | An 'IndexPreservingFold' can be used as a 'Fold', but when composed with an 'IndexedTraversal', -- 'IndexedFold', or 'IndexedLens' yields an 'IndexedFold' respectively.-type IndexPreservingFold s a = forall p f. (Conjoined p, Gettable f, Applicative f) => p a (f a) -> p s (f s)+type IndexPreservingFold s a = forall p f. (Conjoined p, Contravariant f, Applicative f) => p a (f a) -> p s (f s)  ------------------------------------------------------------------------------- -- Actions@@ -497,8 +497,8 @@ -- whenever the type variables don't change upon setting a value. -- -- @--- 'Data.Complex.Lens.imaginary' :: 'Simple' 'Lens' ('Data.Complex.Complex' a) a--- 'Data.List.Lens._head' :: 'Simple' 'IndexedTraversal' 'Int' [a] a+-- 'Data.Complex.Lens._imagPart' :: 'Simple' 'Lens' ('Data.Complex.Complex' a) a+-- 'Control.Lens.Traversal.traversed' :: 'Simple' ('IndexedTraversal' 'Int') [a] a -- @ -- -- Note: To use this alias in your own code with @'LensLike' f@ or

@@ -90,10 +90,10 @@   -- @   -- 'zoom' :: 'Monad' m             => 'Lens'' s t      -> 'StateT' t m a -> 'StateT' s m a   -- 'zoom' :: ('Monad' m, 'Monoid' c) => 'Control.Lens.Traversal.Traversal'' s t -> 'StateT' t m c -> 'StateT' s m c-  -- 'zoom' :: 'Monad' m             => 'Lens'' s t      -> 'RWST' r w t m c -> 'RWST' r w s m c-  -- 'zoom' :: ('Monad' m, 'Monoid' c) => 'Control.Lens.Traversal.Traversal'' s t -> 'RWST' r w t m c -> 'RWST' r w s m c-  -- 'zoom' :: 'Monad' m             => 'Lens'' s t      -> 'ErrorT' e ('RWST' r w t m c) -> 'ErrorT' e ('RWST' r w s m c)-  -- 'zoom' :: ('Monad' m, 'Monoid' c) => 'Control.Lens.Traversal.Traversal'' s t -> 'ErrorT' e ('RWST' r w t m c) -> 'ErrorT' e ('RWST' r w s m c)+  -- 'zoom' :: ('Monad' m, 'Monoid' w)             => 'Lens'' s t      -> 'RWST' r w t m c -> 'RWST' r w s m c+  -- 'zoom' :: ('Monad' m, 'Monoid' w, 'Monoid' c) => 'Control.Lens.Traversal.Traversal'' s t -> 'RWST' r w t m c -> 'RWST' r w s m c+  -- 'zoom' :: ('Monad' m, 'Monoid' w, 'Error' e)  => 'Lens'' s t      -> 'ErrorT' e ('RWST' r w t m) c -> 'ErrorT' e ('RWST' r w s m) c+  -- 'zoom' :: ('Monad' m, 'Monoid' w, 'Monoid' c, 'Error' e) => 'Control.Lens.Traversal.Traversal'' s t -> 'ErrorT' e ('RWST' r w t m) c -> 'ErrorT' e ('RWST' r w s m) c   -- ...   -- @   zoom :: LensLike' (Zoomed m c) t s -> m c -> n c@@ -167,13 +167,13 @@   -- [11,12,13,14,15,16,17,18,19,20]   --   -- @-  -- 'magnify' ::             'Getter' s a -> (a -> r) -> s -> r-  -- 'magnify' :: 'Monoid' c => 'Fold' s a   -> (a -> r) -> s -> r+  -- 'magnify' :: 'Getter' s a -> (a -> r) -> s -> r+  -- 'magnify' :: 'Monoid' r => 'Fold' s a   -> (a -> r) -> s -> r   -- @   --   -- @-  -- 'magnify' :: 'Monoid' w                'Getter' s t -> 'RWST' s w st c -> 'RWST' t w st c-  -- 'magnify' :: ('Monoid' w, 'Monoid' c) => 'Fold' s t   -> 'RWST' s w st c -> 'RWST' t w st c+  -- 'magnify' :: 'Monoid' w                 => 'Getter' s t -> 'RWS' t w st c -> 'RWS' s w st c+  -- 'magnify' :: ('Monoid' w, 'Monoid' c) => 'Fold' s a   -> 'RWS' a w st c -> 'RWS' s w st c   -- ...   -- @   magnify :: LensLike' (Magnified m c) a b -> m c -> n c

@@ -49,7 +49,7 @@ -- 'catching' :: 'MonadError' e m => 'Getter' e a     -> m r -> (a -> m r) -> m r -- 'catching' :: 'MonadError' e m => 'Fold' e a       -> m r -> (a -> m r) -> m r -- @-catching :: MonadError e m => Getting (First a) e t a b -> m r -> (a -> m r) -> m r+catching :: MonadError e m => Getting (First a) e a -> m r -> (a -> m r) -> m r catching l = catchJust (preview l) {-# INLINE catching #-} @@ -66,7 +66,7 @@ -- 'catching_' :: 'MonadError' e m => 'Getter' e a     -> m r -> m r -> m r -- 'catching_' :: 'MonadError' e m => 'Fold' e a       -> m r -> m r -> m r -- @-catching_ :: MonadError e m => Getting (First a) e t a b -> m r -> m r -> m r+catching_ :: MonadError e m => Getting (First a) e a -> m r -> m r -> m r catching_ l a b = catchJust (preview l) a (const b) {-# INLINE catching_ #-} @@ -85,7 +85,7 @@ -- 'handling' :: 'MonadError' e m => 'Fold' e a       -> (a -> m r) -> m r -> m r -- 'handling' :: 'MonadError' e m => 'Getter' e a     -> (a -> m r) -> m r -> m r -- @-handling :: MonadError e m => Getting (First a) e t a b -> (a -> m r) -> m r -> m r+handling :: MonadError e m => Getting (First a) e a -> (a -> m r) -> m r -> m r handling l = flip (catching l) {-# INLINE handling #-} @@ -100,7 +100,7 @@ -- 'handling_' :: 'MonadError' e m => 'Getter' e a     -> m r -> m r -> m r -- 'handling_' :: 'MonadError' e m => 'Fold' e a       -> m r -> m r -> m r -- @-handling_ :: MonadError e m => Getting (First a) e t a b -> m r -> m r -> m r+handling_ :: MonadError e m => Getting (First a) e a -> m r -> m r -> m r handling_ l = flip (catching_ l) {-# INLINE handling_ #-} @@ -119,7 +119,7 @@ -- 'trying' :: 'MonadError' e m => 'Getter' e a     -> m r -> m ('Either' a r) -- 'trying' :: 'MonadError' e m => 'Fold' e a       -> m r -> m ('Either' a r) -- @-trying :: MonadError e m => Getting (First a) e t a b -> m r -> m (Either a r)+trying :: MonadError e m => Getting (First a) e a -> m r -> m (Either a r) trying l m = catching l (liftM Right m) (return . Left)  ------------------------------------------------------------------------------

@@ -21,6 +21,6 @@ -- 'Getter' or 'Fold' according to the given strategy. -- -- @'seqFoldable' = 'seqOf' 'folded'@-seqOf :: Getting (Endo [a]) s t a b -> Strategy a -> Strategy s+seqOf :: Getting (Endo [a]) s a -> Strategy a -> Strategy s seqOf l s = seqList s . toListOf l {-# INLINE seqOf #-}

@@ -129,5 +129,5 @@ -- >>> (mkPolar 10.0 2.0 ^. _conjugate . _phase) ≈ (-2.0) -- True _conjugate :: RealFloat a => Iso' (Complex a) (Complex a)-_conjugate = iso conjugate conjugate+_conjugate = involuted conjugate {-# INLINE _conjugate #-}

@@ -46,6 +46,6 @@ -- 'setOf' :: 'Hashable' a         => 'Lens'' s a      -> s -> 'HashSet' a -- 'setOf' :: ('Eq' a, 'Hashable' a) => 'Traversal'' s a -> s -> 'HashSet' a -- @-setOf :: Hashable a => Getting (HashSet a) s t a b -> s -> HashSet a+setOf :: Hashable a => Getting (HashSet a) s a -> s -> HashSet a setOf l = views l HashSet.singleton {-# INLINE setOf #-}

@@ -58,6 +58,6 @@ -- 'setOf' :: 'Lens'' s 'Int'      -> s -> 'IntSet' -- 'setOf' :: 'Traversal'' s 'Int' -> s -> 'IntSet' -- @-setOf :: Getting IntSet s t Int b -> s -> IntSet+setOf :: Getting IntSet s Int -> s -> IntSet setOf l = views l IntSet.singleton {-# INLINE setOf #-}

@@ -44,9 +44,9 @@ -- | Obtain a 'Fold' by splitting another 'Fold', 'Lens', 'Getter' or 'Traversal' according to the given splitting strategy. -- -- @--- 'splitting' :: 'Splitter' a -> 'Fold' i s a -> 'Fold' [i] s [a]+-- 'splitting' :: 'Splitter' a -> 'Fold' s a -> 'Fold' s [a] -- @-splitting :: Splitter a -> Getting (Endo [a]) s s a a -> Fold s [a]+splitting :: Splitter a -> Getting (Endo [a]) s a -> Fold s [a] splitting s l f = coerce . traverse f . split s . toListOf l {-# INLINE splitting #-} @@ -57,7 +57,7 @@ -- @ -- 'splittingOn' :: 'Eq' a => [a] -> 'Fold' s a -> 'Fold' s [a] -- @-splittingOn :: Eq a => [a] -> Getting (Endo [a]) s s a a -> Fold s [a]+splittingOn :: Eq a => [a] -> Getting (Endo [a]) s a -> Fold s [a] splittingOn s l f = coerce . traverse f . splitOn s . toListOf l {-# INLINE splittingOn #-} @@ -68,7 +68,7 @@ -- @ -- 'splittingOn' :: 'Eq' a => [a] -> 'Fold' s a -> 'Fold' s [a] -- @-splittingOneOf :: Eq a => [a] -> Getting (Endo [a]) s s a a -> Fold s [a]+splittingOneOf :: Eq a => [a] -> Getting (Endo [a]) s a -> Fold s [a] splittingOneOf s l f = coerce . traverse f . splitOneOf s . toListOf l {-# INLINE splittingOneOf #-} @@ -77,9 +77,9 @@ -- Equivalent to @'splitting' '.' 'dropDelims' '.' 'whenElt'@. -- -- @--- 'splittingOn' :: (a -> 'Bool') -> 'Fold' s a -> 'Fold' s [a]+-- 'splittingWhen' :: (a -> 'Bool') -> 'Fold' s a -> 'Fold' s [a] -- @-splittingWhen :: Eq a => (a -> Bool) -> Getting (Endo [a]) s s a a -> Fold s [a]+splittingWhen :: (a -> Bool) -> Getting (Endo [a]) s a -> Fold s [a] splittingWhen s l f = coerce . traverse f . splitWhen s . toListOf l {-# INLINE splittingWhen #-} @@ -90,7 +90,7 @@ -- @ -- 'endingBy' :: 'Eq' a => [a] -> 'Fold' s a -> 'Fold' s [a] -- @-endingBy :: Eq a => [a] -> Getting (Endo [a]) s s a a -> Fold s [a]+endingBy :: Eq a => [a] -> Getting (Endo [a]) s a -> Fold s [a] endingBy s l f = coerce . traverse f . endBy s . toListOf l {-# INLINE endingBy #-} @@ -101,7 +101,7 @@ -- @ -- 'endingByOneOf' :: 'Eq' a => [a] -> 'Fold' s a -> 'Fold' s [a] -- @-endingByOneOf :: Eq a => [a] -> Getting (Endo [a]) s s a a -> Fold s [a]+endingByOneOf :: Eq a => [a] -> Getting (Endo [a]) s a -> Fold s [a] endingByOneOf s l f = coerce . traverse f . endByOneOf s . toListOf l {-# INLINE endingByOneOf #-} @@ -110,9 +110,9 @@ -- Equivalent to @'splitting' '.' 'dropBlanks' '.' 'dropDelims' '.' 'whenElt'@. -- -- @--- 'wordingBy' :: (a -> 'Bool') -> 'Fold' a -> 'Fold' s [a]+-- 'wordingBy' :: (a -> 'Bool') -> 'Fold' s a -> 'Fold' s [a] -- @-wordingBy :: Eq a => (a -> Bool) -> Getting (Endo [a]) s s a a -> Fold s [a]+wordingBy :: (a -> Bool) -> Getting (Endo [a]) s a -> Fold s [a] wordingBy s l f = coerce . traverse f . wordsBy s . toListOf l {-# INLINE wordingBy #-} @@ -123,17 +123,17 @@ -- @ -- 'liningBy' :: (a -> 'Bool') -> 'Fold' s a -> 'Fold' s [a] -- @-liningBy :: Eq a => (a -> Bool) -> Getting (Endo [a]) s s a a -> Fold s [a]+liningBy :: (a -> Bool) -> Getting (Endo [a]) s a -> Fold s [a] liningBy s l f = coerce . traverse f . linesBy s . toListOf l {-# INLINE liningBy #-}  -- | Obtain a 'Fold' by splitting another 'Fold', 'Lens', 'Getter' or 'Traversal' into length-@n@ pieces. -- -- @--- 'chunkingOf' :: 'Int' -> 'Fold' s a -> 'Fold' s [a]+-- 'chunking' :: 'Int' -> 'Fold' s a -> 'Fold' s [a] -- @ chunking :: Int -- ^ @n@-            -> Getting (Endo [a]) s s a a -> Fold s [a]+            -> Getting (Endo [a]) s a -> Fold s [a] chunking s l f = coerce . traverse f . chunksOf s . toListOf l {-# INLINE chunking #-} @@ -142,7 +142,7 @@ -- @ -- 'splittingPlaces' :: 'Integral' n => [n] -> 'Fold' s a -> 'Fold' s [a] -- @-splittingPlaces :: Integral n => [n] -> Getting (Endo [a]) s s a a -> Fold s [a]+splittingPlaces :: Integral n => [n] -> Getting (Endo [a]) s a -> Fold s [a] splittingPlaces s l f = coerce . traverse f . splitPlaces s . toListOf l {-# INLINE splittingPlaces #-} @@ -151,7 +151,7 @@ -- @ -- 'splittingPlacesBlanks' :: 'Integral' n => [n] -> 'Fold' s a -> 'Fold' s [a] -- @-splittingPlacesBlanks :: Integral n => [n] -> Getting (Endo [a]) s s a a -> Fold s [a]+splittingPlacesBlanks :: Integral n => [n] -> Getting (Endo [a]) s a -> Fold s [a] splittingPlacesBlanks s l f = coerce . traverse f . splitPlacesBlanks s . toListOf l {-# INLINE splittingPlacesBlanks #-} 

@@ -51,6 +51,6 @@ -- 'setOf' ::          'Lens'' s a      -> s -> 'Set' a -- 'setOf' :: 'Ord' a => 'Traversal'' s a -> s -> 'Set' a -- @-setOf :: Getting (Set a) s t a b -> s -> Set a+setOf :: Getting (Set a) s a -> s -> Set a setOf l = views l Set.singleton {-# INLINE setOf #-}

@@ -24,7 +24,6 @@   , asStream   , asStreamR   , cloned-  , reversed   -- * Lenses   , sliced   -- * Traversal of individual indices@@ -68,7 +67,7 @@ -- -- >>> toVectorOf both (8,15) :: Vector.Vector Int -- fromList [8,15]-toVectorOf :: Vector v a => Getting (Endo [a]) s t a b -> s -> v a+toVectorOf :: Vector v a => Getting (Endo [a]) s a -> s -> v a toVectorOf l s = fromList (toListOf l s) {-# INLINE toVectorOf #-} @@ -103,17 +102,8 @@ -- | Convert a 'Vector' to a version that doesn't retain any extra -- memory. forced :: Vector v a => Iso' (v a) (v a)-forced = iso force force+forced = involuted force {-# INLINE forced #-}---- | Convert a 'Vector' to a version with all the elements in the--- reverse order.------ >>> Vector.fromList [1,2,3] ^. reversed--- fromList [3,2,1]-reversed :: Vector v a => Iso' (v a) (v a)-reversed = iso reverse reverse-{-# INLINE reversed #-}  -- | This 'Traversal' will ignore any duplicates in the supplied list -- of indices.

@@ -21,7 +21,6 @@   ( toVectorOf   -- * Isomorphisms   , vector-  , reversed   , forced   -- * Lenses   , sliced@@ -60,7 +59,7 @@ -- -- >>> toVectorOf both (8,15) -- fromList [8,15]-toVectorOf :: Getting (Endo [a]) s t a b -> s -> Vector a+toVectorOf :: Getting (Endo [a]) s a -> s -> Vector a toVectorOf l s = fromList (toListOf l s) {-# INLINE toVectorOf #-} @@ -77,15 +76,6 @@ vector :: Iso [a] [b] (Vector a) (Vector b) vector = iso fromList toList {-# INLINE vector #-}---- | Convert a 'Vector' to a version with all the elements in the--- reverse order.------ >>> Vector.fromList [1,2,3] ^. reversed--- fromList [3,2,1]-reversed :: Iso (Vector a) (Vector b) (Vector a) (Vector b)-reversed = iso reverse reverse-{-# INLINE reversed #-}  -- | Convert a 'Vector' to a version that doesn't retain any extra -- memory.

@@ -8,7 +8,15 @@ -- Stability   :  provisional -- Portability :  portable --------------------------------------------------------------------------------module Numeric.Lens (base, integral) where+module Numeric.Lens+  ( base+  , integral+    -- * Predefined bases+  , binary+  , octal+  , decimal+  , hex+  ) where  import Control.Lens import Data.Char (chr, ord, isAsciiLower, isAsciiUpper, isDigit)@@ -36,15 +44,15 @@ -- -- >>> 1767707668033969 ^. re (base 36) -- "helloworld"-base :: Integral a => a -> Prism' String a+base :: Integral a => Int -> Prism' String a base b-  | b < 2 || b > 36 = error ("base: Invalid base " ++ show (toInteger b))+  | b < 2 || b > 36 = error ("base: Invalid base " ++ show b)   | otherwise       = prism intShow intRead   where     intShow n = showSigned' (showIntAtBase (toInteger b) intToDigit') (toInteger n) ""      intRead s =-      case readSigned' (readInt b (isDigit' b) digitToInt') s of+      case readSigned' (readInt (fromIntegral b) (isDigit' b) digitToInt') s of         [(n,"")] -> Right n         _ -> Left s {-# INLINE base #-}@@ -70,9 +78,9 @@   | otherwise = Nothing  -- | Select digits that fall into the given base-isDigit' :: Integral a => a -> Char -> Bool+isDigit' :: Int -> Char -> Bool isDigit' b c = case digitToIntMay c of-  Just i | fromIntegral i < b -> True+  Just i -> i < b   _ -> False  -- | A simpler variant of 'Numeric.showSigned' that only prepends a dash and@@ -87,3 +95,19 @@ readSigned' :: Real a => ReadS a -> ReadS a readSigned' f ('-':xs) = f xs & mapped . _1 %~ negate readSigned' f xs       = f xs++-- | @'binary' = 'base' 2@+binary :: Integral a => Prism' String a+binary = base 2++-- | @'octal' = 'base' 8@+octal :: Integral a => Prism' String a+octal = base 8++-- | @'decimal' = 'base' 10@+decimal :: Integral a => Prism' String a+decimal = base 10++-- | @'hex' = 'base' 16@+hex :: Integral a => Prism' String a+hex = base 16

@@ -23,6 +23,7 @@ import System.FilePath import Test.DocTest +##if defined(mingw32_HOST_OS) ##if defined(i386_HOST_ARCH) ##define USE_CP import Control.Applicative@@ -30,13 +31,14 @@ import Foreign.C.Types foreign import stdcall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool foreign import stdcall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt-##elif defined(x64_64_HOST_ARCH)+##elif defined(x86_64_HOST_ARCH) ##define USE_CP import Control.Applicative import Control.Exception import Foreign.C.Types foreign import ccall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool foreign import ccall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt+##endif ##endif  -- | Run in a modified codepage where we can print UTF-8 values on Windows.