lens 3.3 → 3.4

raw patch · 27 files changed

+632/−736 lines, 27 filesdep −voidPVP ok

version bump matches the API change (PVP)

Dependencies removed: void

API changes (from Hackage documentation)

Files

• CHANGELOG.markdown +18/−0
• examples/Brainfuck.hs +1/−1
• lens.cabal +3/−3
• src/Control/Lens.hs +1/−1
• src/Control/Lens/Evil.hs +58/−0
• src/Control/Lens/Fold.hs +37/−4
• src/Control/Lens/Getter.hs +30/−30
• src/Control/Lens/Indexed.hs +5/−3
• src/Control/Lens/IndexedFold.hs +0/−128
• src/Control/Lens/IndexedLens.hs +1/−1
• src/Control/Lens/IndexedTraversal.hs +8/−5
• src/Control/Lens/Internal.hs +70/−13
• src/Control/Lens/Iso.hs +78/−5
• src/Control/Lens/Plated.hs +6/−326
• src/Control/Lens/TH.hs +17/−17
• src/Control/Lens/Traversal.hs +158/−5
• src/Control/Lens/WithIndex.hs +12/−0
• src/Control/Lens/Zipper.hs +6/−6
• src/Control/Seq/Lens.hs +2/−1
• src/Data/Complex/Lens.hs +3/−0
• src/Data/List/Lens.hs +21/−89
• src/Data/List/Split/Lens.hs +12/−11
• src/Data/Monoid/Lens.hs +3/−7
• src/Data/Sequence/Lens.hs +16/−16
• src/Data/Vector/Generic/Lens.hs +3/−2
• src/Data/Vector/Lens.hs +2/−1
• tests/hunit.hs +61/−61

@@ -1,3 +1,21 @@+3.4+---+* Renamed `(%)` to `(&)` and `(^%)` to `(^&)`. This avoids the conflict with `Data.Ratio`, which was our highest priority conflict with a third party library.+* Switched to a more liberal type for `ignored`+* Removed some "`isplitting`" bad combinators from `Control.Lens.IndexedFold`.+* Made `indexed`, `taking`, and `dropping` and `elementOf` lazier and capable of dealing with infinite traversals and infinite folds.+* Improved `Indexing` to support infinite traversals and folds.+* Removed some of the more redundant combinators from `Control.Lens.Plated`, which already had existing aliases in the rest of the traversal API.+* Moved `partsOf`, `holesOf`, and `elementOf` into `Control.Lens.Traversal`.+* Renamed `query` to `peruse` and `queries` to `peruses`. These are much less contentious names,+  both contain `use` in their name for analogy to `use` and `uses` and the word is about reading.+* Simpler `simple`.+* Added `enum` and `non` to `Control.Lens.Iso`.+* Added `(^?!)` to `Control.Lens.Fold` for unsafe access to the head of a `Fold`.+* Changed `_head`, `_tail`, `_init` and `_last` to Traversals in `Data.List.Lens` and `Data.Sequence.Lens`.+* Eliminated `traverseHead`, `traverseTail`, `traverseInit` and `traverseLast`.+* `partsOf` and `unsafePartsOf` can now also be applied to a `Fold` yielding a `Getter` or to a `MonadicFold` yielding an `Action`.+ 3.3 --- * Redefined `simple` and moved it to `Control.Lens.Iso`. Instead of using `simple l` you can now compose `l.simple` or `simple.l` providing more nuanced control and a more compositional API.

@@ -85,7 +85,7 @@  -- | Initial memory configuration initial :: Memory-initial = zipper (replicate 30000 0) % fromWithin traverse+initial = zipper (replicate 30000 0) & fromWithin traverse  interpret :: Input -> Program -> Output interpret i p = snd $ execRWS (run p) i initial

@@ -1,6 +1,6 @@ name:          lens category:      Data, Lenses-version:       3.3+version:       3.4 license:       BSD3 cabal-version: >= 1.8 license-file:  LICENSE@@ -155,8 +155,7 @@     text                 >= 0.11     && < 0.12,     transformers         >= 0.3      && < 0.4,     unordered-containers >= 0.2      && < 0.3,-    vector               >= 0.9      && < 0.11,-    void                 >= 0.5      && < 0.6+    vector               >= 0.9      && < 0.11    exposed-modules:     Control.Exception.Lens@@ -210,6 +209,7 @@    other-modules:     Control.Lens.Unsafe+    Control.Lens.Evil    if flag(template-haskell)     build-depends: template-haskell >= 2.4 && < 2.9

@@ -41,7 +41,7 @@ -- -- <http://github.com/ekmett/lens/wiki> ----- <<http://github.com/ekmett/lens/wiki/images/Hierarchy-3.3.png>>+-- <<http://github.com/ekmett/lens/wiki/images/Hierarchy-3.4.png>> ---------------------------------------------------------------------------- module Control.Lens   ( module Control.Lens.Type

@@ -0,0 +1,58 @@+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE KindSignatures #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Lens.Evil+-- Copyright   :  (C) 2012 Edward Kmett, Shachaf Ben-Kiki+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  Rank2Types, KindSignatures+--+-- This module is not exported from this package. However, the 'EvilBazaar'+-- type (and only the type) is re-exported from @Control.Lens.Internal@.+--+----------------------------------------------------------------------------+module Control.Lens.Evil+  ( EvilBazaar(..)+  , evilBazaar+  , evilSell+  ) where+++import Control.Applicative++-- | 'EvilBazaar' is like 'Control.Lens.Internal.Bazaar', except that it has an evil 'Gettable' instance+-- where @'Control.Lens.Internal.coerce' = 'Unsafe.Coerce.unsafeCoerce'@.+--+-- This lets us write a suitably polymorphic and lazy 'Control.Lens.Traversal.taking', but there *must* be a better way!.+--+-- This type isn't exported from the package in a way that allows anyone to+-- write 'Unsafe.Coerce.unsafeCoerce' with it. It's only used in the implementation of+-- 'Control.Lens.Traversal.taking'.+--+-- @g@ is a phantom type used in the 'Control.Lens.Internal.Gettable' instance.++newtype EvilBazaar (g :: * -> *) a b s = EvilBazaar (forall f. Applicative f => (a -> f b) -> f s)++instance Functor (EvilBazaar g a b) where+  fmap f (EvilBazaar k) = EvilBazaar (fmap f . k)+  {-# INLINE fmap #-}++instance Applicative (EvilBazaar g a b) where+  pure a = EvilBazaar (\_ -> pure a)+  {-# INLINE pure #-}+  EvilBazaar mf <*> EvilBazaar ma = EvilBazaar (\k -> mf k <*> ma k)+  {-# INLINE (<*>) #-}++-- NB: We can't import .Internal yet, so the 'Gettable' instance is defined there+-- instead.++evilBazaar :: Applicative f => (a -> f b) -> EvilBazaar g a b s -> f s+evilBazaar afb (EvilBazaar m) = m afb+{-# INLINE evilBazaar #-}++-- | A trivial 'Bazaar'.+evilSell :: a -> EvilBazaar f a b b+evilSell i = EvilBazaar (\k -> k i)+{-# INLINE evilSell #-}

@@ -38,7 +38,9 @@   (   -- * Folds     Fold-  , (^?), (^..)+  , (^..)+  , (^?)+  , (^?!), (^!?)   -- ** Building Folds   --, folds   , folding@@ -91,7 +93,7 @@ -- $setup -- >>> import Control.Lens -infixl 8 ^?, ^..+infixl 8 ^.., ^?, ^?!, ^!?  -------------------------- -- Folds@@ -130,6 +132,7 @@ -- @'repeat' ≡ 'toListOf' 'repeated'@ repeated :: Fold a a repeated f a = as where as = f a *> as+{-# INLINE repeated #-}  -- | A fold that replicates its input @n@ times. --@@ -147,6 +150,7 @@ -- [1,2,3,1,2,3] cycled :: (Applicative f, Gettable 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 #-}  -- | Build a fold that unfolds its values from a seed. --@@ -309,8 +313,9 @@ -- 'toListOf' :: 'Simple' 'Control.Lens.Iso.Iso' s a       -> s -> [a] -- 'toListOf' :: 'Simple' 'Control.Lens.Traversal.Traversal' s a -> s -> [a] -- @-toListOf :: Getting [a] s t a b -> s -> [a]-toListOf l = foldMapOf l return+toListOf :: Getting (Endo [a]) s t a b -> s -> [a]+toListOf l = foldrOf l (:) []+-- toListOf l = foldMapOf l return {-# INLINE toListOf #-}  -- |@@ -741,6 +746,34 @@ (^?) :: s -> Getting (First a) s t a b -> Maybe a a ^? l = getFirst (foldMapOf l (first# Just) a) {-# INLINE (^?) #-}++-- | Perform an *UNSAFE* 'head' of a 'Fold' or 'Control.Lens.Traversal.Traversal' assuming that it is there.+--+-- @+-- ('^?!') :: s -> 'Getter' s a           -> a+-- ('^?!') :: s -> 'Fold' s a             -> a+-- ('^?!') :: s -> 'Simple' 'Lens' s a      -> a+-- ('^?!') :: s -> 'Simple' 'Control.Lens.Iso.Iso' s a       -> a+-- ('^?!') :: s -> 'Simple' 'Control.Lens.Traversal.Traversal' s a -> a+-- @+(^?!) :: s -> Getting (First a) s t a b -> a+a ^?! l = fromMaybe (error "(^?!): empty Fold") $ getFirst (foldMapOf l (first# Just) a)+{-# INLINE (^?!) #-}++-- | Perform an *UNSAFE* 'head' of a 'Fold' or 'Control.Lens.Traversal.Traversal' assuming that it is there.+--+-- This is an alias for ('^?!').+--+-- @+-- ('^!?') :: s -> 'Getter' s a           -> a+-- ('^!?') :: s -> 'Fold' s a             -> a+-- ('^!?') :: s -> 'Simple' 'Lens' s a      -> a+-- ('^!?') :: s -> 'Simple' 'Control.Lens.Iso.Iso' s a       -> a+-- ('^!?') :: s -> 'Simple' 'Control.Lens.Traversal.Traversal' s a -> a+-- @+(^!?) :: s -> Getting (First a) s t a b -> a+a ^!? l = fromMaybe (error "(^!?): empty Fold") $ getFirst (foldMapOf l (first# Just) a)+{-# INLINE (^!?) #-}  -- | Perform a safe 'last' of a 'Fold' or 'Control.Lens.Traversal.Traversal' or retrieve 'Just' the result -- from a 'Getter' or 'Lens'.

@@ -52,13 +52,13 @@   , to   -- * Combinators for Getters and Folds   , (^.), (^$)-  , (%), (^%)+  , (&), (^&)   , view   , views   , use   , uses-  , query-  , queries+  , peruse+  , peruses    -- * Storing Getters   , ReifiedGetter(..)@@ -74,8 +74,8 @@ -- $setup -- >>> import Control.Lens -infixl 8 ^., ^%-infixl 1 %+infixl 8 ^., ^&+infixl 1 & infixr 0 ^$  -------------------------------------------------------------------------------@@ -88,21 +88,21 @@ -- for inference. Here it is supplied for notational convenience and given a precedence that allows it -- to be nested inside uses of ('$'). ----- >>> "hello" % length % succ+-- >>> "hello" & length & succ -- 6-(%) :: a -> (a -> b) -> b-a % f = f a-{-# INLINE (%) #-}+(&) :: a -> (a -> b) -> b+a & f = f a+{-# INLINE (&) #-} --- | A version of ('Control.Lens.Combinators.%') with much tighter precedence that can be interleaved with ('^.')+-- | A version of ('&') with much tighter precedence that can be interleaved with ('^.') ----- >>> "hello"^%length+-- >>> "hello" ^& length -- 5 -- >>> import Data.List.Lens--- >>> ("hello","world")^._1^%reverse^._head+-- >>> ("hello","world")^._1^&reverse^!?_head -- 'o'-(^%) :: a -> (a -> b) -> b-a ^% f = f a+(^&) :: a -> (a -> b) -> b+a ^& f = f a  ------------------------------------------------------------------------------- -- Getters@@ -311,15 +311,15 @@ -- to a monoidal value. -- -- @--- 'query' :: 'MonadReader' s m             => 'Getter' s a           -> m a--- 'query' :: ('MonadReader' s m, 'Monoid' a) => 'Control.Lens.Fold.Fold' s a             -> m a--- 'query' :: 'MonadReader' s m             => 'Control.Lens.Type.Simple' 'Control.Lens.Iso.Iso' s a       -> m a--- 'query' :: 'MonadReader' s m             => 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' s a      -> m a--- 'query' :: ('MonadReader' s m, 'Monoid' a) => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' s a -> m a+-- 'peruse' :: 'MonadReader' s m             => 'Getter' s a           -> m a+-- 'peruse' :: ('MonadReader' s m, 'Monoid' a) => 'Control.Lens.Fold.Fold' s a             -> m a+-- 'peruse' :: 'MonadReader' s m             => 'Control.Lens.Type.Simple' 'Control.Lens.Iso.Iso' s a       -> m a+-- 'peruse' :: 'MonadReader' s m             => 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' s a      -> m a+-- 'peruse' :: ('MonadReader' s m, 'Monoid' a) => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' s a -> m a -- @-query :: MonadReader s m => Getting a s t a b -> m a-query l = Reader.asks (^.l)-{-# INLINE query #-}+peruse :: MonadReader s m => Getting a s t a b -> m a+peruse l = Reader.asks (^.l)+{-# INLINE peruse #-}  -- | -- Use the target of a 'Control.Lens.Type.Lens', 'Control.Lens.Iso.Iso' or@@ -328,15 +328,15 @@ -- to a monoidal value. -- -- @--- 'queries' :: 'MonadReader' s m             => 'Getter' s a           -> (a -> r) -> m r--- 'queries' :: ('MonadReader' s m, 'Monoid' a) => 'Control.Lens.Fold.Fold' s a             -> (a -> r) -> m r--- 'queries' :: 'MonadReader' s m             => 'Control.Lens.Type.Simple' 'Control.Lens.Iso.Iso' s a       -> (a -> r) -> m r--- 'queries' :: 'MonadReader' s m             => 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' s a      -> (a -> r) -> m r--- 'queries' :: ('MonadReader' s m, 'Monoid' a) => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' s a -> (a -> r) -> m r+-- 'peruses' :: 'MonadReader' s m             => 'Getter' s a           -> (a -> r) -> m r+-- 'peruses' :: ('MonadReader' s m, 'Monoid' a) => 'Control.Lens.Fold.Fold' s a             -> (a -> r) -> m r+-- 'peruses' :: 'MonadReader' s m             => 'Control.Lens.Type.Simple' 'Control.Lens.Iso.Iso' s a       -> (a -> r) -> m r+-- 'peruses' :: 'MonadReader' s m             => 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' s a      -> (a -> r) -> m r+-- 'peruses' :: ('MonadReader' s m, 'Monoid' a) => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' s a -> (a -> r) -> m r -- @-queries :: MonadReader s m => Getting r s t a b -> (a -> r) -> m r-queries l f = Reader.asks (views l f)-{-# INLINE queries #-}+peruses :: MonadReader s m => Getting r s t a b -> (a -> r) -> m r+peruses l f = Reader.asks (views l f)+{-# INLINE peruses #-}  -- | Useful for storing getters in containers. newtype ReifiedGetter s a = ReifyGetter { reflectGetter :: Getter s a }

@@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-} ----------------------------------------------------------------------------- -- | -- Module      :  Control.Lens.Indexed@@ -86,7 +87,7 @@ icompose ijk (Index ibc) (Index jab) = index $ \ka -> ibc $ \i -> jab $ \j -> ka (ijk i j) {-# INLINE icompose #-} --- | Transform an Traversal into an IndexedTraversal, a Fold into an IndexedFold, etc.+-- | Transform an 'Traversal' into an 'Control.Lens.IndexedTraversal.IndexedTraversal', a 'Fold' into an 'Control.Lens.IndexedFold.IndexedFold', etc. -- -- @ -- 'indexed' :: 'Control.Lens.Traversal.Traversal' s t a b -> 'Control.Lens.IndexedTraversal.IndexedTraversal' 'Int' s t a b@@ -96,6 +97,7 @@ -- 'indexed' :: 'Control.Lens.Getter.Getter' s t        -> 'Control.Lens.IndexedGetter.IndexedGetter' 'Int' s t a b -- @ indexed :: Indexed Int k => ((a -> Indexing f b) -> s -> Indexing f t) -> k (a -> f b) (s -> f t)-indexed l = index $ \iafb s -> case runIndexing (l (\a -> Indexing (\i -> IndexingResult (iafb i a) (i + 1))) s) 0 of-  IndexingResult r _ -> r+indexed l = index $ \iafb s -> case runIndexing (l (\a -> Indexing (\i -> (iafb i a, i + 1))) s) 0 of+  (r, _) -> r {-# INLINE indexed #-}+

@@ -46,17 +46,6 @@   , ibackwards   , itakingWhile   , idroppingWhile-  , isplitting-  , isplittingOn-  , isplittingOneOf-  , isplittingWhen-  , iendingBy-  , iendingByOneOf-  , iwordingBy-  , iliningBy-  , ichunkingOf-  , isplittingPlaces-  , isplittingPlacesBlanks    -- * Storing Indexed Folds   , ReifiedIndexedFold(..)@@ -64,16 +53,13 @@  import Control.Applicative import Control.Applicative.Backwards-import Data.Traversable (traverse) import Control.Lens.Indexed import Control.Lens.IndexedGetter import Control.Lens.Internal import Control.Lens.Unsafe import Control.Lens.Type-import Control.Lens.Fold (toListOf) import Control.Monad import Data.Monoid-import Data.List.Split  ------------------------------------------------------------------------------ -- Indexed Folds@@ -450,120 +436,6 @@               -> k (a -> f a) (s -> f s) idroppingWhile p l = index $ \ f -> fst . ifoldrOf l (\i a r -> let s = f i a *> snd r in if p i a then (fst r, s) else (s, s)) (noEffect, noEffect) {-# INLINE idroppingWhile #-}---- | Obtain an 'IndexedFold' by splitting another 'IndexedFold', 'Control.Lens.IndexedLens.IndexedLens', 'IndexedGetter' or 'Control.Lens.IndexedTraversal.IndexedTraversal' according to the given splitting strategy.------ @--- 'isplitting' :: 'Splitter' (i, a) -> 'IndexedFold' i s a -> 'IndexedFold' [i] s [a]--- @-isplitting :: (Applicative f, Gettable f, Indexed [i] k) => Splitter (i, a) -> IndexedGetting i [(i, a)] s s a a -> k ([a] -> f [a]) (s -> f s)-isplitting s l = index $ \ f -> coerce . traverse (uncurry f . unzip) . split s . toListOf (withIndicesOf l)-{-# INLINE isplitting #-}---- | Obtain an 'IndexedFold' by splitting another 'IndexedFold', 'Control.Lens.IndexedLens.IndexedLens', 'IndexedGetter' or 'Control.Lens.IndexedTraversal.IndexedTraversal' on the given delimiter.------ Equivalent to @'isplitting' '.' 'dropDelims' '.' 'onSublist'@.------ @--- 'isplittingOn' :: ('Eq' i, 'Eq' a) => [(i, a)] -> 'IndexedFold' i s a -> 'IndexedFold' [i] s [a]--- @-isplittingOn :: (Applicative f, Gettable f, Indexed [i] k, Eq i, Eq a) => [(i, a)] -> IndexedGetting i [(i, a)] s s a a -> k ([a] -> f [a]) (s -> f s)-isplittingOn s l = index $ \ f -> coerce . traverse (uncurry f . unzip) . splitOn s . toListOf (withIndicesOf l)-{-# INLINE isplittingOn #-}---- | Obtain an 'IndexedFold' by splitting another 'IndexedFold', 'Control.Lens.IndexedLens.IndexedLens', 'IndexedGetter' or 'Control.Lens.IndexedTraversal.IndexedTraversal' on any of the given elements.------ Equivalent to @'isplitting' '.' 'dropDelims' '.' 'oneOf'@.------ @--- 'isplittingOneOf' :: ('Eq' i, 'Eq' a) => [(i, a)] -> 'IndexedFold' i s a -> 'IndexedFold' [i] s [a]--- @-isplittingOneOf :: (Applicative f, Gettable f, Indexed [i] k, Eq i, Eq a) => [(i, a)] -> IndexedGetting i [(i, a)] s s a a -> k ([a] -> f [a]) (s -> f s)-isplittingOneOf s l = index $ \ f -> coerce . traverse (uncurry f . unzip) . splitOneOf s . toListOf (withIndicesOf l)-{-# INLINE isplittingOneOf #-}---- | Obtain an 'IndexedFold' by splitting another 'IndexedFold', 'Control.Lens.IndexedLens.IndexedLens', 'IndexedGetter' or 'Control.Lens.IndexedTraversal.IndexedTraversal' on elements satisfying the given predicate.------ Equivalent to @'isplitting' '.' 'dropDelims' '.' 'whenElt' '.' 'uncurry'@.------ @--- 'isplittingWhen' :: (i -> a -> 'Bool') -> 'IndexedFold' i s a -> 'IndexedFold' [i] s [a]--- @-isplittingWhen :: (Applicative f, Gettable f, Indexed [i] k) => (i -> a -> Bool) -> IndexedGetting i [(i, a)] s s a a -> k ([a] -> f [a]) (s -> f s)-isplittingWhen s l = index $ \ f -> coerce . traverse (uncurry f . unzip) . splitWhen (uncurry s) . toListOf (withIndicesOf l)-{-# INLINE isplittingWhen #-}---- | Obtain an 'IndexedFold' by splitting another 'IndexedFold', 'Control.Lens.IndexedLens.IndexedLens', 'IndexedGetter' or 'Control.Lens.IndexedTraversal.IndexedTraversal' into chunks terminated by the given delimiter.------ Equivalent to @'isplitting' '.' 'dropDelims' '.' 'onSublist'@.------ @--- 'iendingBy' :: ('Eq' i, 'Eq' a) => [(i, a)] -> 'IndexedFold' i s a -> 'IndexedFold' [i] s [a]--- @-iendingBy :: (Applicative f, Gettable f, Indexed [i] k, Eq i, Eq a) => [(i, a)] -> IndexedGetting i [(i, a)] s s a a -> k ([a] -> f [a]) (s -> f s)-iendingBy s l = index $ \ f -> coerce . traverse (uncurry f . unzip) . endBy s . toListOf (withIndicesOf l)-{-# INLINE iendingBy #-}---- | Obtain an 'IndexedFold' by splitting another 'IndexedFold', 'Control.Lens.IndexedLens.IndexedLens', 'IndexedGetter' or 'Control.Lens.IndexedTraversal.IndexedTraversal' into chunks terminated by any of the given elements.------ Equivalent to @'isplitting' '.' 'dropFinalBlank' '.' 'dropDelims' '.' 'oneOf'@.------ @--- 'iendingByOneOf' :: ('Eq' i, 'Eq' a) => [(i, a)] -> 'IndexedFold' i s a -> 'IndexedFold' [i] s [a]--- @-iendingByOneOf :: (Applicative f, Gettable f, Indexed [i] k, Eq i, Eq a) => [(i, a)] -> IndexedGetting i [(i, a)] s s a a -> k ([a] -> f [a]) (s -> f s)-iendingByOneOf s l = index $ \ f -> coerce . traverse (uncurry f . unzip) . endByOneOf s . toListOf (withIndicesOf l)-{-# INLINE iendingByOneOf #-}---- | Obtain an 'IndexedFold' by splitting another 'IndexedFold', 'Control.Lens.IndexedLens.IndexedLens', 'IndexedGetter' or 'Control.Lens.IndexedTraversal.IndexedTraversal' into "words", with word boundaries indicated by the given predicate.------ Equivalent to @'isplitting' '.' 'dropBlanks' '.' 'dropDelims' '.' 'whenElt' '.' 'uncurry'@.------ @--- 'iwordingBy' :: (i -> a -> 'Bool') -> 'IndexedFold' i s a -> 'IndexedFold' [i] s [a]--- @-iwordingBy :: (Applicative f, Gettable f, Indexed [i] k) => (i -> a -> Bool) -> IndexedGetting i [(i, a)] s s a a -> k ([a] -> f [a]) (s -> f s)-iwordingBy s l = index $ \ f -> coerce . traverse (uncurry f . unzip) . wordsBy (uncurry s) . toListOf (withIndicesOf l)-{-# INLINE iwordingBy #-}---- | Obtain an 'IndexedFold' by splitting another 'IndexedFold', 'Control.Lens.IndexedLens.IndexedLens', 'IndexedGetter' or 'Control.Lens.IndexedTraversal.IndexedTraversal' into "lines", with line boundaries indicated by the given predicate.------ Equivalent to @'isplitting' '.' 'dropFinalBlank' '.' 'dropDelims' '.' 'whenElt' '.' 'uncurry'@.------ @--- 'iliningBy' :: (i -> a -> 'Bool') -> 'IndexedFold' i s a -> 'IndexedFold' [i] s [a]--- @-iliningBy :: (Applicative f, Gettable f, Indexed [i] k) => (i -> a -> Bool) -> IndexedGetting i [(i, a)] s s a a -> k ([a] -> f [a]) (s -> f s)-iliningBy s l = index $ \ f -> coerce . traverse (uncurry f . unzip) . linesBy (uncurry s) . toListOf (withIndicesOf l)-{-# INLINE iliningBy #-}---- | Obtain an 'IndexedFold' by splitting another 'IndexedFold', 'Control.Lens.IndexedLens.IndexedLens', 'IndexedGetter' or 'Control.Lens.IndexedTraversal.IndexedTraversal' into length-@n@ pieces.------ @--- 'ichunkingOf' :: 'Int' -> 'IndexedFold' i s a -> 'IndexedFold' [i] s [a]--- @-ichunkingOf :: (Applicative f, Gettable f, Indexed [i] k) => Int -- ^ @n@-               -> IndexedGetting i [(i, a)] s s a a -> k ([a] -> f [a]) (s -> f s)-ichunkingOf s l = index $ \ f -> coerce . traverse (uncurry f . unzip) . chunksOf s . toListOf (withIndicesOf l)-{-# INLINE ichunkingOf #-}---- | Obtain an 'IndexedFold' by splitting another 'IndexedFold', 'Control.Lens.IndexedLens.IndexedLens', 'IndexedGetter' or 'Control.Lens.IndexedTraversal.IndexedTraversal' into chunks of the given lengths.------ @--- 'isplittingPlaces' :: 'Integral' n => [n] -> 'IndexedFold' i s a -> 'IndexedFold' [i] s [a]--- @-isplittingPlaces :: (Applicative f, Gettable f, Indexed [i] k, Integral n) => [n] -> IndexedGetting i [(i, a)] s s a a -> k ([a] -> f [a]) (s -> f s)-isplittingPlaces s l = index $ \ f -> coerce . traverse (uncurry f . unzip) . splitPlaces s . toListOf (withIndicesOf l)-{-# INLINE isplittingPlaces #-}---- | Obtain an 'IndexedFold' by splitting another 'IndexedFold', 'Control.Lens.IndexedLens.IndexedLens', 'IndexedGetter' or 'Control.Lens.IndexedTraversal.IndexedTraversal' into chunks of the given lengths.  Unlike 'isplittingPlaces', the output 'IndexedFold' will always be the same length as the first input argument.------ @--- 'isplittingPlacesBlanks' :: 'Integral' n => [n] -> 'IndexedFold' i s a -> 'IndexedFold' [i] s [a]--- @-isplittingPlacesBlanks :: (Applicative f, Gettable f, Indexed [i] k, Integral n) => [n] -> IndexedGetting i [(i, a)] s s a a -> k ([a] -> f [a]) (s -> f s)-isplittingPlacesBlanks s l = index $ \ f -> coerce . traverse (uncurry f . unzip) . splitPlacesBlanks s . toListOf (withIndicesOf l)-{-# INLINE isplittingPlacesBlanks #-}  ------------------------------------------------------------------------------ -- Reifying Indexed Folds

@@ -191,7 +191,7 @@ -- | This lens can be used to change the result of a function but only where -- the arguments match the key given. ----- >>> let f = (+1) % resultAt 3 .~ 8 in (f 2, f 3)+-- >>> let f = (+1) & resultAt 3 .~ 8 in (f 2, f 3) -- (3,8) resultAt :: Eq e => e -> SimpleIndexedLens e (e -> a) a resultAt e = index $ \ g f -> (\a' e' -> if e == e' then a' else f e') <$> g e (f e)

@@ -36,6 +36,7 @@   , ignored   , TraverseMin(..)   , TraverseMax(..)+  , traversed    -- * Indexed Traversal Combinators   , itraverseOf@@ -62,7 +63,6 @@ import Data.Traversable import Data.IntMap as IntMap import Data.Map as Map-import Data.Void  -- $setup -- >>> import Control.Lens@@ -207,6 +207,10 @@ traverseAt k = at k <. traverse {-# INLINE traverseAt #-} +-- | Traverse any 'Traversable' container. This is an 'IndexedTraversal' that is indexed by ordinal position.+traversed :: Traversable f => IndexedTraversal Int (f a) (f b) a b+traversed = indexed traverse+ -- | This provides a 'Traversal' that checks a predicate on a key before -- allowing you to traverse into a value. value :: (k -> Bool) -> SimpleIndexedTraversal k (k, v) v@@ -215,13 +219,12 @@  -- | This is the trivial empty traversal. ----- @'ignored' :: 'IndexedTraversal' 'Void' s s a b+-- @'ignored' :: 'IndexedTraversal' i s s a b@ -- -- @'ignored' ≡ 'const' 'pure'@-ignored :: forall s a b k f. (Indexed Void k, Applicative f) => Overloaded k f s s a b-ignored = index $ \ (_ :: Void -> a -> f b) s -> pure s :: f s+ignored :: forall k f i s a b. (Indexed i k, Applicative f) => Overloaded k f s s a b+ignored = index $ \ (_ :: i -> a -> f b) s -> pure s :: f s {-# INLINE ignored #-}-  -- | Allows 'IndexedTraversal' the value at the smallest index. class Ord k => TraverseMin k m | m -> k where

@@ -26,7 +26,43 @@ -- \"Family\" and need to add instances. -- -----------------------------------------------------------------------------module Control.Lens.Internal where+module Control.Lens.Internal+  (+  -- * Internal Classes+    Gettable(..)+  , Effective(..), ineffective, noEffect+  , Settable(..)+  -- * Internal Types+  , May(..)+  , Folding(..)+  , Effect(..)+  , EffectRWS(..)+  , Accessor(..)+  , Err(..)+  , Traversed(..)+  , Sequenced(..)+  , Focusing(..)+  , FocusingWith(..)+  , FocusingPlus(..)+  , FocusingOn(..)+  , FocusingMay(..)+  , FocusingErr(..)+  , Mutator(..)+  , Bazaar(..), bazaar, duplicateBazaar, sell+  , Context(..)+  , Max(..), getMax+  , Min(..), getMin+  , ElementOfResult(..), ElementOf(..)+  , Indexing(..)+  , Level(..)+  , levelWidth+  , leftLevel, left1Level, leftmostLevel+  , rightmostLevel, rightLevel, right1Level+  , focusLevel+  , rezipLevel+  -- * Evil Internal Types+  , EvilBazaar+  ) where  import Control.Applicative import Control.Applicative.Backwards@@ -34,6 +70,7 @@ import Control.Comonad import Control.Comonad.Store.Class import Control.Lens.Isomorphic+import Control.Lens.Evil (EvilBazaar) import Control.Monad import Prelude hiding ((.),id) import Data.Foldable@@ -137,28 +174,23 @@   pure = FocusingErr . pure   FocusingErr kf <*> FocusingErr ka = FocusingErr (kf <*> ka) --- | The result of 'Indexing'-data IndexingResult f a = IndexingResult (f a) {-# UNPACK #-} !Int--instance Functor f => Functor (IndexingResult f) where-  fmap f (IndexingResult fa n) = IndexingResult (fmap f fa) n- -- | Applicative composition of @'Control.Monad.Trans.State.Lazy.State' 'Int'@ with a 'Functor', used -- by 'Control.Lens.Indexed.indexed'-newtype Indexing f a = Indexing { runIndexing :: Int -> IndexingResult f a }+newtype Indexing f a = Indexing { runIndexing :: Int -> (f a, Int) }  instance Functor f => Functor (Indexing f) where-  fmap f (Indexing m) = Indexing $ \i -> fmap f (m i)+  fmap f (Indexing m) = Indexing $ \i -> case m i of+    (x, j) -> (fmap f x, j)  instance Applicative f => Applicative (Indexing f) where-  pure = Indexing . IndexingResult . pure+  pure x = Indexing (\i -> (pure x, i))   Indexing mf <*> Indexing ma = Indexing $ \i -> case mf i of-    IndexingResult ff j -> case ma j of-       IndexingResult fa k -> IndexingResult (ff <*> fa) k+    (ff, j) -> case ma j of+       ~(fa, k) -> (ff <*> fa, k)  instance Gettable f => Gettable (Indexing f) where   coerce (Indexing m) = Indexing $ \i -> case m i of-    IndexingResult ff j -> IndexingResult (coerce ff) j+    (ff, j) -> (coerce ff, j)  -- | Used internally by 'Control.Lens.Traversal.traverseOf_' and the like. newtype Traversed f = Traversed { getTraversed :: f () }@@ -229,6 +261,8 @@   seeks f (Context g a) = Context g (f a)   experiment f (Context g a) = g <$> f a ++ -- | This is used to characterize a 'Control.Lens.Traversal.Traversal'. -- -- a.k.a. indexed Cartesian store comonad, indexed Kleene store comonad, or an indexed 'FunList'.@@ -555,3 +589,26 @@     EQ -> a     GT -> rs Prelude.!! (n - m) +data ElementOfResult f a = Searching Int a (Maybe (f a))++instance Functor f => Functor (ElementOfResult f) where+  fmap f (Searching i a as) = Searching i (f a) (fmap f <$> as)++newtype ElementOf f a = ElementOf { getElementOf :: Int -> ElementOfResult f a }++instance Functor f => Functor (ElementOf f) where+  fmap f (ElementOf m) = ElementOf (fmap f . m)++instance Functor f => Applicative (ElementOf f) where+  pure a = ElementOf $ \i -> Searching i a Nothing+  ElementOf mf <*> ElementOf ma = ElementOf $ \i -> case mf i of+    Searching j f mff -> case ma j of+      ~(Searching k a maa) -> Searching k (f a) $ fmap ($ a) <$> mff+                                              <|> fmap f <$> maa+instance Gettable f => Gettable (ElementOf f) where+  coerce (ElementOf m) = ElementOf $ \i -> case m i of+    Searching j _ mas -> Searching j (error "coerced while searching") (coerce <$> mas)++-- See Control.Lens.Evil.+instance Gettable g => Gettable (EvilBazaar g a b) where+    coerce = unsafeCoerce

@@ -16,9 +16,12 @@     Iso   , iso   , isos+  -- * Working with isomorphisms   , ala   , auf   , under+  , mapping+  , review   -- * Primitive isomorphisms   , from   , via@@ -28,6 +31,8 @@   , _const   , identity   , simple+  , non+  , enum   -- * Storing Isomorphisms   , ReifiedIso(..)   -- * Simplicity@@ -43,10 +48,12 @@ import Control.Lens.Setter import Control.Lens.Type import Data.Functor.Identity+import Data.Maybe (fromMaybe) import Prelude hiding ((.),id)  -- $setup -- >>> import Control.Lens+-- >>> import Data.Map as Map  ----------------------------------------------------------------------------- -- Isomorphisms families as Lenses@@ -76,7 +83,7 @@ -- 'view' ('isos' sa as tb bt) ≡ sa -- 'view' ('from' ('isos' sa as tb bt)) ≡ as -- 'set' ('isos' sa as tb bt) ab ≡ bt '.' ab '.' sa--- 'set' ('from' ('isos' ac ca bd db')) ab ≡ bd '.' ab '.' ca+-- 'set' ('from' ('isos' ac ca bd db)) ab ≡ bd '.' ab '.' ca -- @ -- -- @isos :: (s -> a) -> (a -> s) -> (t -> b) -> (b -> t) -> 'Iso' s t a b@@@ -92,8 +99,8 @@ -- @ -- 'view' ('iso' f g) ≡ f -- 'view' ('from' ('iso' f g)) ≡ g--- 'set' ('isos' f g) h ≡ g '.' h '.' f--- 'set' ('from' ('iso' f g')) h ≡ f '.' h '.' g+-- 'set' ('iso' f g) h ≡ g '.' h '.' f+-- 'set' ('from' ('iso' f g)) h ≡ f '.' h '.' g -- @ -- -- @iso :: (s -> a) -> (a -> s) -> 'Control.Lens.Type.Simple' 'Iso' s a@@@ -128,6 +135,13 @@ under = over . from {-# INLINE under #-} +-- | This can be used to turn an 'Iso' around and 'view' the other way.+--+-- @'review' = 'view' '.' 'from'@+review :: Overloaded Isomorphism (Accessor s) s t a b -> a -> s+review (Isomorphism _ l) = view l+{-# INLINE review #-}+ ----------------------------------------------------------------------------- -- Isomorphisms -----------------------------------------------------------------------------@@ -152,13 +166,72 @@ _const = isos Const getConst Const getConst {-# INLINE _const #-} +-- | This isomorphism can be used to convert to or from an instance of 'Enum'.+--+-- >>> LT^.from enum+-- 0+--+-- >>> 97^.enum :: Char+-- 'a'+--+-- Note: this is only an isomorphism from the numeric range actually used+-- and it is a bit of a pleasant fiction, since there are questionable+-- 'Enum' instances for 'Double', and 'Float' that exist solely for+-- @[1.0 .. 4.0]@ sugar and the instances for those and 'Integer' don't+-- cover all values in their range.+enum :: Enum a => Simple Iso Int a+enum = iso toEnum fromEnum+{-# INLINE enum #-} +-- | This can be used to lift any 'SimpleIso' into an arbitrary functor.+mapping :: Functor f => SimpleIso s a -> SimpleIso (f s) (f a)+mapping l = iso (view l <$>) (view (from l) <$>)+{-# INLINE mapping #-}+ -- | Composition with this isomorphism is occasionally useful when your 'Lens', -- 'Control.Lens.Traversal.Traversal' or 'Iso' has a constraint on an unused -- argument to force that argument to agree with the -- type of a used argument and avoid @ScopedTypeVariables@ or other ugliness.-simple :: Iso a b a b-simple = isos id id id id+simple :: Simple Iso a a+simple = isomorphic id id+{-# INLINE simple #-}++-- | If @v@ is an element of a type @a@, and @a'@ is @a@ sans the element @v@, then @non v@ is an isomorphism from+-- @Maybe a'@ to @a@.+--+-- Keep in mind this is only a real isomorphism if you treat the domain as being @'Maybe' (a sans v)@+--+-- This is practically quite useful when you want to have a map where all the entries should have non-zero values.+--+-- >>> Map.fromList [("hello",1)] & at "hello" . non 0 +~ 2+-- fromList [("hello",3)]+--+-- >>> Map.fromList [("hello",1)] & at "hello" . non 0 -~ 1+-- fromList []+--+-- >>> Map.fromList [("hello",1)] ^. at "hello" . non 0+-- 1+--+-- >>> Map.fromList [] ^. at "hello" . non 0+-- 0+--+-- This combinator is also particularly useful when working with nested maps.+--+-- /e.g./ When you want to create the nested map when it is missing:+--+-- >>> Map.empty & at "hello" . non Map.empty . at "world" ?~ "!!!"+-- fromList [("hello",fromList [("world","!!!")])]+--+-- and when have deleting the last entry from the nested map mean that we +-- should delete its entry from the surrounding one:+--+-- >>> fromList [("hello",fromList [("world","!!!")])] & at "hello" . non Map.empty . at "world" .~ Nothing+-- fromList []++non :: Eq a => a -> Simple Iso (Maybe a) a+non a = iso (fromMaybe a) go where+  go b | a == b    = Nothing+       | otherwise = Just b  ----------------------------------------------------------------------------- -- Reifying Isomorphisms

@@ -2,6 +2,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} ------------------------------------------------------------------------------- -- |@@ -49,49 +50,36 @@     Plated(..)    -- * Uniplate Combinators-  , children, childrenOn+  , children   , rewrite, rewriteOf, rewriteOn, rewriteOnOf   , rewriteM, rewriteMOf, rewriteMOn, rewriteMOnOf   , universe, universeOf, universeOn, universeOnOf   , transform, transformOf, transformOn, transformOnOf   , transformM, transformMOf, transformMOn, transformMOnOf-  , descend, descendOf, descendOn, descendOnOf-  , descendA, descendAOf, descendAOn, descendAOnOf-  , descendA_, descendAOf_, descendAOn_, descendAOnOf_-  , descendM, descendMOf, descendMOn, descendMOnOf-  , descendM_, descendMOf_, descendMOn_, descendMOnOf_   , contexts, contextsOf, contextsOn, contextsOnOf-  , holes, holesOf, holesOn, holesOnOf+  , holes, holesOn, holesOnOf   , para, paraOf    -- * Compos   -- $compos   , composOpFold -  -- * Indexing into a Traversal-  , element-  , elementOf-   -- * Parts   , parts-  , partsOf--  -- ** Unsafe Operations-  , unsafePartsOf   )   where  import Control.Applicative-import Control.Monad.State import Control.Lens.Fold import Control.Lens.Getter import Control.Lens.Internal import Control.Lens.Setter import Control.Lens.Traversal import Control.Lens.Type-import Data.Tree import Data.Data import Data.Data.Lens+import Data.Monoid+import Data.Tree  -- | A 'Plated' type is one where we know how to extract its immediate self-similar children. --@@ -205,15 +193,6 @@ children = toListOf plate {-# INLINE children #-} --- | Provided for compatibility with @uniplate@.------ @'childrenOn' ≡ 'toListOf'@------ @'childrenOn' :: 'Fold' s a -> s -> [a]@-childrenOn :: Getting [a] s t a b -> s -> [a]-childrenOn = toListOf-{-# INLINE childrenOn #-}- ------------------------------------------------------------------------------- -- Rewriting -------------------------------------------------------------------------------@@ -407,201 +386,6 @@ {-# INLINE transformMOnOf #-}  ---------------------------------------------------------------------------------- Descent------------------------------------------------------------------------------------ | Recurse one level into a structure. (a.k.a @composOp@ from Björn Bringert's @compos@)------ @'descend' ≡ 'over' 'plate'@-descend :: Plated a => (a -> a) -> a -> a-descend = over plate-{-# INLINE descend #-}---- | Recurse one level into a structure using a user specified recursion scheme. This is 'over', but it is supplied here--- for consistency with the uniplate API.------ @'descendOf' ≡ 'over'@------ @--- 'descendOf' :: 'Simple' 'Setter' s a -> (a -> a) -> s -> s--- 'descendOf' :: 'Simple' 'Traversal' s a -> (a -> a) -> s -> s--- @-descendOf :: Setting s t a b -> (a -> b) -> s -> t-descendOf = over-{-# INLINE descendOf #-}---- | Recurse one level into the parts delimited by one 'Setter', using another.------ @'descendOnOf' b l ≡ 'over' (b '.' l)@------ @--- 'descendOnOf' :: 'Simple' 'Setter' s a    -> 'Simple' 'Setter' a a    -> (a -> a) -> s -> s--- 'descendOnOf' :: 'Simple' 'Traversal' s a -> 'Simple' 'Traversal' a a -> (a -> a) -> s -> s--- @----descendOnOf :: Setting s t a b -> Setting a b u v -> (u -> v) -> s -> t-descendOnOf b l = over (b.l)-{-# INLINE descendOnOf #-}---- | Recurse one level into the parts of the structure delimited by a 'Setter'.------ @'descendOn' b ≡ 'over' (b '.' 'plate')@------ @'descendOn' :: 'Plated' a => 'Setter' s t -> (t -> t) -> s -> s@-descendOn :: Plated a => Setting s t a a -> (a -> a) -> s -> t-descendOn b = over (b . plate)-{-# INLINE descendOn #-}------------------------------------------------------------------------------------ Applicative Descent------------------------------------------------------------------------------------ | Recurse one level into a structure with an 'Applicative' effect, this is 'plate', but it is supplied--- for consistency with the uniplate API.------ @'descendA' ≡ 'plate'@-descendA :: (Applicative f, Plated a) => (a -> f a) -> a -> f a-descendA = plate-{-# INLINE descendA #-}---- | Recurse one level into a structure using a user specified recursion scheme and 'Applicative' effects. This is 'id', but it is supplied--- for consistency with the uniplate API.------ @'descendAOf' ≡ 'id'@------ @'descendAOf' :: 'Applicative' m => 'Simple' 'Traversal' s a => (a -> m a) -> s -> m s@-descendAOf :: Applicative f => LensLike f s t a b -> (a -> f b) -> s -> f t-descendAOf = id-{-# INLINE descendAOf #-}---- | Recurse one level into the parts delimited by one 'Traversal', using another with 'Applicative' effects.------ @'descendAOnOf' ≡ ('.')@------ @'descendAOnOf' :: 'Applicative' f => 'Simple' 'Traversal' s a -> 'Simple' 'Traversal' a a -> (a -> f a) -> s -> f s@-descendAOnOf :: Applicative f => LensLike f u v s t -> LensLike f s t a b -> (a -> f b) -> u -> f v-descendAOnOf = (.)-{-# INLINE descendAOnOf #-}---- | Recurse one level into the parts of the structure delimited by a 'Traversal' with 'Applicative' effects.------ @'descendAOn' b ≡ b '.' 'plate'@------ @'descendAOn' :: ('Applicative' f, Plated' a) => 'Simple' 'Traversal' s a -> (a -> f a) -> s -> f s@-descendAOn :: (Applicative f, Plated a) => LensLike f s t a a -> (a -> f a) -> s -> f t-descendAOn b = b . plate-{-# INLINE descendAOn #-}---- |------ @'descendA_' ≡ traverseOf_' 'plate'@-descendA_ :: (Applicative f, Plated a) => (a -> f b) -> a -> f ()-descendA_ = traverseOf_ plate-{-# INLINE descendA_ #-}---- | Recurse one level into a structure using a user specified recursion scheme and 'Applicative' effects, without reconstructing the structure behind you.------ This is just 'traverseOf_', but is provided for consistency.------ @'descendAOf_' ≡ 'traverseOf_'@------ @'descendAOf_' :: 'Applicative' f => 'Fold' s a => (a -> f r) -> s -> f ()@-descendAOf_ :: Applicative f => Getting (Traversed f) s t a b -> (a -> f r) -> s -> f ()-descendAOf_ = traverseOf_-{-# INLINE descendAOf_ #-}---- | Recurse one level into the parts delimited by one 'Fold', using another with 'Applicative' effects, without reconstructing the structure behind you.------ @'descendAOnOf_' b l ≡ 'traverseOf_' (b '.' l)@------ @'descendAOnOf_' :: 'Applicative' f => 'Fold' s a -> 'Fold' a a -> (a -> f r) -> s -> f ()@-descendAOnOf_ :: Applicative f => Getting (Traversed f) s t a b -> Getting (Traversed f) a b a b -> (a -> f r) -> s -> f ()-descendAOnOf_ b l = traverseOf_ (b . l)-{-# INLINE descendAOnOf_ #-}---- | Recurse one level into the parts of the structure delimited by a 'Traversal' with monadic effects.------ @'descendAOn_' b ≡ 'traverseOf_' (b '.' 'plate')@------ @'descendAOn_' :: ('Applicative' f, 'Plated' a) => 'Simple' 'Traversal' s a -> (a -> f r) -> s -> f ()@-descendAOn_ :: (Applicative f, Plated a) => Getting (Traversed f) s t a a -> (a -> f r) -> s -> f ()-descendAOn_ b = traverseOf_ (b . plate)-{-# INLINE descendAOn_ #-}------------------------------------------------------------------------------------ Monadic Descent------------------------------------------------------------------------------------ | Recurse one level into a structure with a monadic effect. (a.k.a @composOpM@ from Björn Bringert's @compos@)------ @'descendM' ≡ 'mapMOf' 'plate'@-descendM :: (Monad m, Plated a) => (a -> m a) -> a -> m a-descendM = mapMOf plate-{-# INLINE descendM #-}---- | Recurse one level into a structure using a user specified recursion scheme and monadic effects. This is 'id', but it is--- supplied for consistency with the uniplate API.------ @'descendMOf' ≡ 'mapMOf'@------ @'descendMOf' :: 'Monad' m => 'Simple' 'Traversal' s a => (a -> m a) -> s -> m s@-descendMOf :: Monad m => LensLike (WrappedMonad m) s t a b -> (a -> m b) -> s -> m t-descendMOf = mapMOf-{-# INLINE descendMOf #-}---- | Recurse one level into the parts delimited by one 'Traversal', using another with monadic effects.------ @'descendMOnOf' b l ≡ 'mapMOf' (b '.' l)@------ @'descendMOnOf' :: 'Monad' m => 'Simple' 'Traversal' s a -> 'Simple' 'Traversal' a a -> (a -> m a) -> s -> m s@-descendMOnOf :: Monad m => LensLike (WrappedMonad m) s t a a -> SimpleLensLike (WrappedMonad m) a a -> (a -> m a) -> s -> m t-descendMOnOf b l = mapMOf (b . l)-{-# INLINE descendMOnOf #-}---- | Recurse one level into the parts of the structure delimited by a 'Traversal' with monadic effects.------ @'descendMOn' b ≡ 'mapMOf' (b . 'plate')@------ @'descendMOn' :: ('Monad' m, 'Plated' a) => 'Simple' 'Traversal' s a -> (a -> m a) -> s -> m s@-descendMOn :: (Monad m, Plated a) => LensLike (WrappedMonad m) s t a a -> (a -> m a) -> s -> m t-descendMOn b = mapMOf (b . plate)-{-# INLINE descendMOn #-}---- | Descend one level into a structure with monadic effects (a.k.a @composOpM@ from Björn Bringert's @compos@)------ @'descendM_' ≡ mapMOf_' 'plate'@-descendM_ :: (Monad m, Plated a) => (a -> m b) -> a -> m ()-descendM_ = mapMOf_ plate-{-# INLINE descendM_ #-}---- | Recurse one level into a structure using a user specified recursion scheme and monadic effects. This is just 'mapMOf_', but is provided for consistency.------ @'descendMOf_' ≡ 'mapMOf_'@------ @'descendMOf_' :: 'Monad' m => 'Fold' s a => (a -> m a) -> s -> m ()@-descendMOf_ :: Monad m => Getting (Sequenced m) s t a b -> (a -> m r) -> s -> m ()-descendMOf_ = mapMOf_-{-# INLINE descendMOf_ #-}---- | Recurse one level into the parts delimited by one 'Traversal', using another with monadic effects.------ @'descendMOnOf_' b l ≡ 'mapMOf_' (b '.' l)@------ @'descendMOnOf_' :: 'Monad' m => 'Fold' s a -> 'Fold' a a -> (a -> m a) -> s -> m ()@-descendMOnOf_ :: Monad m => Getting (Sequenced m) s t a b -> Getting (Sequenced m) a b a b -> (a -> m r) -> s -> m ()-descendMOnOf_ b l = mapMOf_ (b . l)-{-# INLINE descendMOnOf_ #-}---- | Recurse one level into the parts of the structure delimited by a 'Traversal' with monadic effects.------ @'descendMOn_' b ≡ 'mapMOf_' (b '.' 'plate')@------ @'descendMOn_' :: ('Monad' m, 'Plated' a) => 'Simple' 'Traversal' s a -> (a -> m r) -> b -> m ()@-descendMOn_ :: (Monad m, Plated a) => Getting (Sequenced m) s t a a -> (a -> m r) -> s -> m ()-descendMOn_ b = mapMOf_ (b . plate)-{-# INLINE descendMOn_ #-}--------------------------------------------------------------------------------- -- Holes and Contexts ------------------------------------------------------------------------------- @@ -668,28 +452,6 @@ holes = holesOf plate {-# INLINE holes #-} --- | The one-level version of 'contextsOf'. This extracts a list of the immediate children according to a given 'Traversal' as editable contexts.------ Given a context you can use 'pos' to see the values, 'peek' at what the structure would be like with an edited result, or simply 'extract' the original structure.------ @--- propChildren l x = 'childrenOf' l x '==' 'map' 'pos' ('holesOf' l x)--- propId l x = 'all' ('==' x) [extract w | w <- 'holesOf' l x]--- @------ @--- 'holesOf' :: 'Simple' 'Iso' s a       -> s -> ['Context' a a s]--- 'holesOf' :: 'Simple' 'Lens' s a      -> s -> ['Context' a a s]--- 'holesOf' :: 'Simple' 'Traversal' s a -> s -> ['Context' a a s]--- @-holesOf :: LensLike (Bazaar a a) s t a a -> s -> [Context a a t]-holesOf l a = f (ins b) (outs b) where-  b = l sell a-  f []     _ = []-  f (x:xs) g = Context (g . (:xs)) x : f xs (g . (x:))-{-# INLINE holesOf #-}-- -- | An alias for 'holesOf', provided for consistency with the other combinators. -- -- @'holesOn' ≡ 'holesOf'@@@ -723,7 +485,7 @@ -- | Perform a fold-like computation on each value, technically a paramorphism. -- -- @'paraOf' :: 'Fold' a a -> (a -> [r] -> r) -> a -> r@-paraOf :: Getting [a] a b a b -> (a -> [r] -> r) -> a -> r+paraOf :: Getting (Endo [a]) a b a b -> (a -> [r] -> r) -> a -> r paraOf l f = go where   go a = f a (go <$> toListOf l a) {-# INLINE paraOf #-}@@ -774,85 +536,3 @@ parts :: Plated a => Simple Lens a [a] parts = partsOf plate {-# INLINE parts #-}---- | 'partsOf' turns a 'Traversal' into a lens that resembles an early version of the @uniplate@ (or @biplate@) type.------ /Note:/ You should really try to maintain the invariant of the number of children in the list.------ Any extras will be lost. If you do not supply enough, then the remainder will come from the original structure.------ So technically, this is only a lens if you do not change the number of results it returns.------ @--- 'partsOf' :: 'Simple' 'Control.Lens.Iso.Iso' s a       -> 'Simple' 'Lens' s [a]--- 'partsOf' :: 'Simple' 'Lens' s a      -> 'Simple' 'Lens' s [a]--- 'partsOf' :: 'Simple' 'Traversal' s a -> 'Simple' 'Lens' s [a]--- @-partsOf :: LensLike (Bazaar a a) s t a a -> Lens s t [a] [a]-partsOf l f s = outs b <$> f (ins b) where b = l sell s-{-# INLINE partsOf #-}---- | 'unsafePartsOf' turns a 'Traversal' into a @uniplate@ (or @biplate@) family.------ If you do not need the types of @s@ and @t@ to be different, it is recommended that--- you use 'partsOf'------ It is generally safer to traverse with the 'Bazaar' rather than use this--- combinator. However, it is sometimes convenient.------ This is unsafe because if you don't supply at least as many @b@'s as you were--- given @a@'s, then the reconstruction of @t@ /will/ result in an error!------ @--- 'unsafePartsOf' :: 'Control.Lens.Iso.Iso' s t a b       -> 'Lens' s t [a] [b]--- 'unsafePartsOf' :: 'Lens' s t a b      -> 'Lens' s t [a] [b]--- 'unsafePartsOf' :: 'Traversal' s t a b -> 'Lens' s t [a] [b]--- @-unsafePartsOf :: LensLike (Bazaar a b) s t a b -> Lens s t [a] [b]-unsafePartsOf l f s = unsafeOuts b <$> f (ins b) where b = l sell s-{-# INLINE unsafePartsOf #-}----------------------------------------------------------------------------------- Common Lenses----------------------------------------------------------------------------------- | A 'Lens' to 'Control.Lens.Getter.view'/'Control.Lens.Setter.set' the nth element 'elementOf' a 'Traversal', 'Lens' or 'Control.Lens.Iso.Iso'.------ Attempts to access beyond the range of the 'Traversal' will cause an error.------ >>> [[1],[3,4]]^.elementOf (traverse.traverse) 1--- 3-elementOf :: Functor f => LensLike (Bazaar a a) s t a a -> Int -> LensLike f s t a a-elementOf l k f s = case holesOf l s !! k of-  Context g a -> g <$> f a---- | Access the /nth/ element of a 'Traversable' container.------ Attempts to access beyond the range of the 'Traversal' will cause an error.------ @'element' ≡ 'elementOf' 'traverse'@-element :: Traversable t => Int -> Simple Lens (t a) a-element = elementOf traverse------------------------------------------------------------------------------------ Misc.----------------------------------------------------------------------------------ins :: Bazaar a b t -> [a]-ins = toListOf bazaar-{-# INLINE ins #-}--unconsWithDefault :: a -> [a] -> (a,[a])-unconsWithDefault d []     = (d,[])-unconsWithDefault _ (x:xs) = (x,xs)-{-# INLINE unconsWithDefault #-}--outs :: Bazaar a a t -> [a] -> t-outs = evalState . bazaar (\oldVal -> state (unconsWithDefault oldVal))-{-# INLINE outs #-}--unsafeOuts :: Bazaar a b t -> [b] -> t-unsafeOuts = evalState . bazaar (\_ -> state (unconsWithDefault fakeVal))-  where fakeVal = error "unsafePartsOf: not enough elements were supplied"-{-# INLINE unsafeOuts #-}-

@@ -186,21 +186,21 @@ -- for isomorphisms and traversals, and not making any classes. lensRules :: LensRules lensRules = defaultRules-  % lensIso          .~ const Nothing-  % lensClass        .~ const Nothing-  % handleSingletons .~ True-  % partialLenses    .~ False-  % buildTraversals  .~ True+  & lensIso          .~ const Nothing+  & lensClass        .~ const Nothing+  & handleSingletons .~ True+  & partialLenses    .~ False+  & buildTraversals  .~ True  -- | Rules for making lenses and traversals that precompose another lens. classyRules :: LensRules classyRules = defaultRules-  % lensIso .~ const Nothing-  % handleSingletons .~ False-  % lensClass .~ classy-  % classRequired .~ True-  % partialLenses .~ False-  % buildTraversals .~ True+  & lensIso .~ const Nothing+  & handleSingletons .~ False+  & lensClass .~ classy+  & classRequired .~ True+  & partialLenses .~ False+  & buildTraversals .~ True   where     classy :: String -> Maybe (String, String)     classy n@(a:as) = Just ("Has" ++ n, toLower a:as)@@ -209,9 +209,9 @@ -- | Rules for making an isomorphism from a data type isoRules :: LensRules isoRules = defaultRules-  % handleSingletons  .~ True-  % singletonRequired .~ True-  % singletonAndField .~ True+  & handleSingletons  .~ True+  & singletonRequired .~ True+  & singletonAndField .~ True  -- | Build lenses (and traversals) with a sensible default configuration. --@@ -271,7 +271,7 @@ -- > makeLensesFor [("_foo", "fooLens"), ("baz", "lbaz")] ''Foo -- > makeLensesFor [("_barX", "bar"), ("_barY", "bar)] ''Bar makeLensesFor :: [(String, String)] -> Name -> Q [Dec]-makeLensesFor fields = makeLensesWith $ lensRules % lensField .~ (`Prelude.lookup` fields)+makeLensesFor fields = makeLensesWith $ lensRules & lensField .~ (`Prelude.lookup` fields)  -- | Derive lenses and traversals, using a named wrapper class, and specifying -- explicit pairings of @(fieldName, traversalName)@.@@ -281,8 +281,8 @@ -- > makeClassyFor "HasFoo" "foo" [("_foo", "fooLens"), ("bar", "lbar")] ''Foo makeClassyFor :: String -> String -> [(String, String)] -> Name -> Q [Dec] makeClassyFor clsName funName fields = makeLensesWith $ classyRules-  % lensClass .~ const (Just (clsName,funName))-  % lensField .~ (`Prelude.lookup` fields)+  & lensClass .~ const (Just (clsName,funName))+  & lensField .~ (`Prelude.lookup` fields)  -- | Build lenses with a custom configuration. makeLensesWith :: LensRules -> Name -> Q [Dec]

@@ -32,6 +32,9 @@   -- * Lenses     Traversal +  -- ** Lensing Traversals+  , element, elementOf+   -- * Traversing and Lensing   , traverseOf, forOf, sequenceAOf   , mapMOf, forMOf, sequenceOf@@ -39,6 +42,10 @@   , mapAccumLOf, mapAccumROf   , scanr1Of, scanl1Of +  -- * Parts and Holes+  , partsOf, unsafePartsOf+  , holesOf+   -- * Common Traversals   , Traversable(traverse)   , traverseLeft@@ -59,12 +66,14 @@  import Control.Applicative              as Applicative import Control.Applicative.Backwards+import Control.Lens.Evil import Control.Lens.Fold import Control.Lens.Internal import Control.Lens.Unsafe import Control.Lens.Type import Control.Monad.State.Class        as State import Control.Monad.Trans.State.Lazy   as Lazy+import Data.Maybe import Data.Traversable  -- $setup@@ -297,6 +306,132 @@   step (Just s) a = (Just r, r) where r = f s a {-# INLINE scanl1Of #-} +-------------------------------------------------------------------------------+-- Parts and Holes+-------------------------------------------------------------------------------++-- | 'partsOf' turns a 'Traversal' into a 'Lens' that resembles an early version of the @uniplate@ (or @biplate@) type.+--+-- /Note:/ You should really try to maintain the invariant of the number of children in the list.+--+-- Any extras will be lost. If you do not supply enough, then the remainder will come from the original structure.+--+-- So technically, this is only a lens if you do not change the number of results it returns.+--+-- When applied to a 'Fold' the result is merely a 'Getter'.+--+-- @+-- 'partsOf' :: 'Simple' 'Control.Lens.Iso.Iso' s a       -> 'Simple' 'Lens' s [a]+-- 'partsOf' :: 'Simple' 'Lens' s a      -> 'Simple' 'Lens' s [a]+-- 'partsOf' :: 'Simple' 'Traversal' s a -> 'Simple' 'Lens' s [a]+-- 'partsOf' :: 'Fold' s a             -> 'Getter' s [a]+-- 'partsOf' :: 'Getter' s a           -> 'Getter' s [a]+-- @+partsOf :: Functor f => LensLike (EvilBazaar f a a) s t a a -> LensLike f s t [a] [a]+partsOf l f s = evilOuts b <$> f (evilIns b) where b = l evilSell s+{-# INLINE partsOf #-}++-- | 'unsafePartsOf' turns a 'Traversal' into a @uniplate@ (or @biplate@) family.+--+-- If you do not need the types of @s@ and @t@ to be different, it is recommended that+-- you use 'partsOf'+--+-- It is generally safer to traverse with the 'Bazaar' rather than use this+-- combinator. However, it is sometimes convenient.+--+-- This is unsafe because if you don't supply at least as many @b@'s as you were+-- given @a@'s, then the reconstruction of @t@ /will/ result in an error!+--+-- @+-- 'unsafePartsOf' :: 'Control.Lens.Iso.Iso' s t a b       -> 'Lens' s t [a] [b]+-- 'unsafePartsOf' :: 'Lens' s t a b      -> 'Lens' s t [a] [b]+-- 'unsafePartsOf' :: 'Traversal' s t a b -> 'Lens' s t [a] [b]+-- 'unsafePartsOf' :: 'Fold' s a          -> 'Getter' s [a]+-- 'unsafePartsOf' :: 'Getter' s a        -> 'Getter' s [a]+-- @+unsafePartsOf :: Functor f => LensLike (EvilBazaar f a b) s t a b -> LensLike f s t [a] [b]+unsafePartsOf l f s = unsafeEvilOuts b <$> f (evilIns b) where b = l evilSell s+{-# INLINE unsafePartsOf #-}++-- | The one-level version of 'contextsOf'. This extracts a list of the immediate children according to a given 'Traversal' as editable contexts.+--+-- Given a context you can use 'pos' to see the values, 'peek' at what the structure would be like with an edited result, or simply 'extract' the original structure.+--+-- @+-- propChildren l x = 'childrenOf' l x '==' 'map' 'pos' ('holesOf' l x)+-- propId l x = 'all' ('==' x) [extract w | w <- 'holesOf' l x]+-- @+--+-- @+-- 'holesOf' :: 'Simple' 'Iso' s a       -> s -> ['Context' a a s]+-- 'holesOf' :: 'Simple' 'Lens' s a      -> s -> ['Context' a a s]+-- 'holesOf' :: 'Simple' 'Traversal' s a -> s -> ['Context' a a s]+-- @+holesOf :: LensLike (Bazaar a a) s t a a -> s -> [Context a a t]+holesOf l a = f (ins b) (outs b) where+  b = l sell a+  f []     _ = []+  f (x:xs) g = Context (g . (:xs)) x : f xs (g . (x:))+{-# INLINE holesOf #-}++-- | A 'Lens' to 'Control.Lens.Getter.view'/'Control.Lens.Setter.set' the nth element 'elementOf' a 'Traversal', 'Lens' or 'Control.Lens.Iso.Iso'.+--+-- Attempts to access beyond the range of the 'Traversal' will cause an error. This also works transparently+-- with Folds, returning a getter.+--+-- >>> [[1],[3,4]] & elementOf (traverse.traverse) 1 .~ 5+-- [[1],[5,4]]+--+-- >>> [[1],[3,4]]^.elementOf (folded.folded) 1+-- 3+--+-- >>> [0..]^.elementOf folded 5+-- 5+--+-- >>> take 10 $ (elementOf traverse 3 .~ 16) [0..]+-- [0,1,2,16,4,5,6,7,8,9]+elementOf :: Functor f => LensLike (ElementOf f) s t a a -> Int -> LensLike f s t a a+elementOf l i f s = case getElementOf (l go s) 0 of+    Searching _ _ mft -> fromMaybe (error "elOf: index out of range") mft+  where+    go a = ElementOf $ \j -> Searching (j + 1) a (if i == j then Just (f a) else Nothing)++-- | Access the /nth/ element of a 'Traversable' container.+--+-- Attempts to access beyond the range of the 'Traversal' will cause an error.+--+-- @'element' ≡ 'elementOf' 'traverse'@+element :: Traversable t => Int -> Simple Lens (t a) a+element = elementOf traverse+++-- Internal functions used in the implementation of partsOf and holesOf.+ins :: Bazaar a b t -> [a]+ins = toListOf bazaar+{-# INLINE ins #-}++outs :: Bazaar a a t -> [a] -> t+outs = evalState . bazaar (\oldVal -> State.state (unconsWithDefault oldVal))+{-# INLINE outs #-}++evilIns :: EvilBazaar f a b s -> [a]+evilIns = toListOf evilBazaar+{-# INLINE evilIns #-}++evilOuts :: EvilBazaar f a a s -> [a] -> s+evilOuts = evalState . evilBazaar (\oldVal -> State.state (unconsWithDefault oldVal))+{-# INLINE evilOuts #-}++unsafeEvilOuts :: EvilBazaar f a b t -> [b] -> t+unsafeEvilOuts = evalState . evilBazaar (\_ -> State.state (unconsWithDefault fakeVal))+  where fakeVal = error "unsafePartsOf: not enough elements were supplied"+{-# INLINE unsafeEvilOuts #-}++unconsWithDefault :: a -> [a] -> (a,[a])+unconsWithDefault d []     = (d,[])+unconsWithDefault _ (x:xs) = (x,xs)+{-# INLINE unconsWithDefault #-}+ ------------------------------------------------------------------------------ -- Traversals ------------------------------------------------------------------------------@@ -362,15 +497,33 @@ {-# INLINE traverseRight #-}  -- | Visit the first /n/ targets of a 'Traversal', 'Fold', 'Getter' or 'Lens'.-taking :: Applicative f => Int -> SimpleLensLike (Indexing f) s a -> SimpleLensLike f s a-taking n l f s = case runIndexing (l (\a -> Indexing $ \i -> IndexingResult (if i < n then f a else pure a) (i + 1)) s) 0 of-  IndexingResult r _ -> r+--+-- >>> [("hello","world"),("!!!","!!!")]^.. taking 2 (traverse.both)+-- ["hello","world"]+--+-- >>> [1..]^.. taking 3 traverse+-- [1,2,3]+--+-- >>> over (taking 5 traverse) succ "hello world"+-- "ifmmp world"+taking :: Applicative f => Int -> SimpleLensLike (EvilBazaar f a a) s a -> SimpleLensLike f s a+taking n l f s = evilOuts bz <$> traverse f (take n $ evilIns bz)+  where+    bz = l (\i -> EvilBazaar ($ i)) s {-# INLINE taking #-}  -- | Visit all but the first /n/ targets of a 'Traversal', 'Fold', 'Getter' or 'Lens'.+--+-- >>> ("hello","world") ^? dropping 1 both+-- Just "world"+--+-- Dropping works on infinite traversals as well.+--+-- >>> [1..]^? dropping 1 folded+-- Just 2 dropping :: Applicative f => Int -> SimpleLensLike (Indexing f) s a -> SimpleLensLike f s a-dropping n l f s = case runIndexing (l (\a -> Indexing $ \i -> IndexingResult (if i >= n then f a else pure a) (i + 1)) s) 0 of-  IndexingResult r _ -> r+dropping n l f s = case runIndexing (l (\a -> Indexing $ \i -> (if i >= n then f a else pure a, i + 1)) s) 0 of+  (r, _) -> r {-# INLINE dropping #-}  ------------------------------------------------------------------------------

@@ -11,6 +11,10 @@ {-# LANGUAGE DefaultSignatures #-} #define MPTC_DEFAULTS #endif++#ifndef MIN_VERSION_containers+#define MIN_VERSION_containers(x,y,z) 1+#endif ------------------------------------------------------------------------------- -- | -- Module      :  Control.Lens.WithIndex@@ -441,7 +445,11 @@ instance FoldableWithIndex Int IntMap where   ifoldMap = ifoldMapOf itraversed instance TraversableWithIndex Int IntMap where+#if MIN_VERSION_containers(0,5,0)+  itraverse = IntMap.traverseWithKey+#else   itraverse f = sequenceA . IntMap.mapWithKey f+#endif   {-# INLINE itraverse #-}  instance Ord k => FunctorWithIndex k (Map k) where@@ -449,7 +457,11 @@ instance Ord k => FoldableWithIndex k (Map k) where   ifoldMap = ifoldMapOf itraversed instance Ord k => TraversableWithIndex k (Map k) where+#if MIN_VERSION_containers(0,5,0)+  itraverse = Map.traverseWithKey+#else   itraverse f = sequenceA . Map.mapWithKey f+#endif   {-# INLINE itraverse #-}  instance (Eq k, Hashable k) => FunctorWithIndex k (HashMap k) where

@@ -40,7 +40,7 @@ -- Since individual levels of a zipper are managed by an arbitrary 'Traversal', -- you can move left and right through the 'Traversal' selecting neighboring elements. ----- >>> zipper ("hello","world") % down _1 % fromWithin traverse % focus .~ 'J' % rightmost % focus .~ 'y' % rezip+-- >>> zipper ("hello","world") & down _1 & fromWithin traverse & focus .~ 'J' & rightmost & focus .~ 'y' & rezip -- ("Jelly","world") -- -- This is particularly powerful when compiled with 'Control.Lens.Plated.plate',@@ -82,7 +82,7 @@ import Control.Lens.Indexed import Control.Lens.IndexedLens import Control.Lens.Internal-import Control.Lens.Plated+import Control.Lens.Traversal import Control.Lens.Type import Data.List.NonEmpty as NonEmpty import Prelude hiding ((.),id)@@ -121,7 +121,7 @@   Coil :: Coil Top a   Snoc :: Coil h b ->           {-# UNPACK #-} !Int ->-          SimpleLensLike (Bazaar a a) b a ->+          SimpleLensLike (EvilBazaar (Context [a] [a]) a a) b a ->           [b] -> (NonEmpty a -> b) -> [b] ->           Coil (h :> b) a @@ -267,7 +267,7 @@ -- 'within' :: 'Simple' 'Lens' b c      -> (a :> b) -> Maybe (a :> b :> c) -- 'within' :: 'Simple' 'Iso' b c       -> (a :> b) -> Maybe (a :> b :> c) -- @-within :: SimpleLensLike (Bazaar c c) b c -> (a :> b) -> Maybe (a :> b :> c)+within :: SimpleLensLike (EvilBazaar (Context [c] [c]) c c) b c -> (a :> b) -> Maybe (a :> b :> c) within l (Zipper h (Level n ls b rs)) = case partsOf l (Context id) b of   Context _ []     -> Nothing   Context k (c:cs) -> Just (Zipper (Snoc h n l ls (k . NonEmpty.toList) rs) (Level 0 [] c cs))@@ -289,7 +289,7 @@ -- -- but it is lazier in such a way that if this invariant is violated, some code -- can still succeed if it is lazy enough in the use of the focused value.-fromWithin :: SimpleLensLike (Bazaar c c) b c -> (a :> b) -> a :> b :> c+fromWithin :: SimpleLensLike (EvilBazaar (Context [c] [c]) c c) b c -> (a :> b) -> a :> b :> c fromWithin l (Zipper h (Level n ls b rs)) = case partsOf l (Context id) b of   Context k cs -> Zipper (Snoc h n l ls (k . NonEmpty.toList) rs)                          (Level 0 [] (Prelude.head cs) (Prelude.tail cs))@@ -317,7 +317,7 @@  data Track :: * -> * -> * where   Track :: Track Top a-  Fork  :: Track h b -> {-# UNPACK #-} !Int -> SimpleLensLike (Bazaar a a) b a -> Track (h :> b) a+  Fork  :: Track h b -> {-# UNPACK #-} !Int -> SimpleLensLike (EvilBazaar (Context [a] [a]) a a) b a -> Track (h :> b) a  restoreTrack :: Track h a -> Zipped h a -> Maybe (h :> a) restoreTrack Track = Just . zipper

@@ -15,11 +15,12 @@  import Control.Lens import Control.Seq+import Data.Monoid  -- | Evaluate the elements targeted by a 'Lens', 'Traversal', 'Iso', -- 'Getter' or 'Fold' according to the given strategy. -- -- @'seqFoldable' = 'seqOf' 'folded'@-seqOf :: Getting [a] s t a b -> Strategy a -> Strategy s+seqOf :: Getting (Endo [a]) s t a b -> Strategy a -> Strategy s seqOf l s = seqList s . toListOf l {-# INLINE seqOf #-}

@@ -1,4 +1,7 @@ {-# LANGUAGE CPP #-}+#ifndef MIN_VERSION_base+#define MIN_VERSION_base(x,y,z) 1+#endif ----------------------------------------------------------------------------- -- | -- Module      :  Data.Complex.Lens

@@ -21,115 +21,47 @@   , _tail   , _last   , _init-  -- * Traversals-  , traverseHead-  , traverseTail-  , traverseInit-  , traverseLast   ) where  import Control.Applicative import Control.Lens --- | A partial 'Lens' reading and writing to the 'head' of a /non-empty/ list.------ Attempting to read or write to the 'head' of an /empty/ list will result in an 'error'.+-- | A 'Traversal' reading and writing to the 'head' of a /non-empty/ list. ----- >>> [1,2,3]^._head+-- >>> [1,2,3]^!?_head -- 1-_head :: Simple Lens [a] a-_head _ [] = error "_head: empty list"-_head f (a:as) = (:as) <$> f a+_head :: SimpleIndexedTraversal Int [a] a+_head = index $ \f aas -> case aas of+  (a:as) -> (:as) <$> f (0 :: Int) a+  _      -> pure aas {-# INLINE _head #-} --- | A partial 'Lens' reading and writing to the 'tail' of a /non-empty/ list------ Attempting to read or write to the 'tail' of an /empty/ list will result in an 'error'.+-- | A 'Traversal' reading and writing to the 'tail' of a /non-empty/ list -- -- >>> _tail .~ [3,4,5] $ [1,2] -- [1,3,4,5]-_tail :: Simple Lens [a] [a]-_tail _ [] = error "_tail: empty list"+_tail :: Simple Traversal [a] [a] _tail f (a:as) = (a:) <$> f as+_tail _ as     = pure as {-# INLINE _tail #-} --- | A partial 'Lens' reading and writing to the last element of a /non-empty/ list------ Attempting to read or write to the last element of an /empty/ list will result in an 'error'.+-- | A 'Traversal' reading and writing to the last element of a /non-empty/ list ----- >>> [1,2]^._last+-- >>> [1,2]^!?_last -- 2-_last :: Simple Lens [a] a-_last _ []     = error "_last: empty list"-_last f [a]    = return <$> f a-_last f (a:as) = (a:) <$> _last f as+_last :: SimpleIndexedTraversal Int [a] a+_last = index $ \f aas -> case aas of+  []     -> pure aas+  (a:as) -> let go !n b []  = return <$> f n b+                go !n b (c:cs) = (b:) <$> go (n + 1) c cs+            in go (0 :: Int) a as {-# INLINE _last #-} --- | A partial 'Lens' reading and replacing all but the a last element of a /non-empty/ list------ Attempting to read or write to all but the last element of an /empty/ list will result in an 'error'.+-- | A 'Traversal' reading and replacing all but the a last element of a /non-empty/ list ----- >>> [1,2,3,4]^._init+-- >>> [1,2,3,4]^!?_init -- [1,2,3]-_init :: Simple Lens [a] [a]-_init _ [] = error "_init: empty list"+_init :: Simple Traversal [a] [a]+_init _ [] = pure [] _init f as = (++ [Prelude.last as]) <$> f (Prelude.init as) {-# INLINE _init #-}---- | A traversal for reading and writing to the head of a list------ The position of the head in the original list (0) is available as the index.------ >>> traverseHead +~ 1 $ [1,2,3]--- [2,2,3]------ @'traverseHead' :: 'Applicative' f => (a -> f a) -> [a] -> f [a]@-traverseHead :: SimpleIndexedTraversal Int [a] a-traverseHead = index $ \f aas -> case aas of-  []     -> pure []-  (a:as) -> (:as) <$> f (0::Int) a-{-# INLINE traverseHead #-}---- | A traversal for editing the tail of a list------ The position of each element /in the original list/ is available as the index.------ >>> traverseTail +~ 1 $ [1,2,3]--- [1,3,4]------ @'traverseTail' :: 'Applicative' f => (a -> f a) -> [a] -> f [a]@-traverseTail :: SimpleIndexedTraversal Int [a] a-traverseTail = index $ \f aas -> case aas of-  []     -> pure []-  (a:as) -> (a:) <$> itraverse (f . (+1)) as-{-# INLINE traverseTail #-}---- | A traversal the last element in a list------ The position of the last element in the original list is available as the index.------ >>> traverseLast +~ 1 $ [1,2,3]--- [1,2,4]------ @'traverseLast' :: 'Applicative' f => (a -> f a) -> [a] -> f [a]@-traverseLast :: SimpleIndexedTraversal Int [a] a-traverseLast = index $ \f xs0 -> let-    go [a]    n = return <$> f n a-    go (a:as) n = (a:) <$> (go as $! n + 1)-    go []     _ = pure []-  in go xs0 (0::Int) where-{-# INLINE traverseLast #-}---- | A traversal of all but the last element of a list------ The position of each element is available as the index.------ >>> traverseInit +~ 1 $ [1,2,3]--- [2,3,3]------ @'traverseInit' :: 'Applicative' f => (a -> f a) -> [a] -> f [a]@-traverseInit :: SimpleIndexedTraversal Int [a] a-traverseInit = index $ \f aas -> case aas of-  [] -> pure []-  as -> (++ [Prelude.last as]) <$> itraverse f (Prelude.init as)-{-# INLINE traverseInit #-}

@@ -39,6 +39,7 @@ import Control.Applicative import Control.Lens import Control.Lens.Internal+import Data.Monoid import Data.List.Split import Data.List.Split.Internals @@ -50,7 +51,7 @@ -- @ -- 'splitting' :: 'Splitter' a -> 'Fold' i s a -> 'Fold' [i] s [a] -- @-splitting :: (Applicative f, Gettable f) => Splitter a -> Getting [a] s s a a -> LensLike f s s [a] [a]+splitting :: (Applicative f, Gettable f) => Splitter a -> Getting (Endo [a]) s s a a -> LensLike f s s [a] [a] splitting s l f = coerce . traverse f . split s . toListOf l {-# INLINE splitting #-} @@ -61,7 +62,7 @@ -- @ -- 'splittingOn' :: 'Eq' a => [a] -> 'Fold' s a -> 'Fold' s [a] -- @-splittingOn :: (Applicative f, Gettable f, Eq a) => [a] -> Getting [a] s s a a -> LensLike f s s [a] [a]+splittingOn :: (Applicative f, Gettable f, Eq a) => [a] -> Getting (Endo [a]) s s a a -> LensLike f s s [a] [a] splittingOn s l f = coerce . traverse f . splitOn s . toListOf l {-# INLINE splittingOn #-} @@ -72,7 +73,7 @@ -- @ -- 'splittingOn' :: 'Eq' a => [a] -> 'Fold' s a -> 'Fold' s [a] -- @-splittingOneOf :: (Applicative f, Gettable f, Eq a) => [a] -> Getting [a] s s a a -> LensLike f s s [a] [a]+splittingOneOf :: (Applicative f, Gettable f, Eq a) => [a] -> Getting (Endo [a]) s s a a -> LensLike f s s [a] [a] splittingOneOf s l f = coerce . traverse f . splitOneOf s . toListOf l {-# INLINE splittingOneOf #-} @@ -83,7 +84,7 @@ -- @ -- 'splittingOn' :: (a -> 'Bool') -> 'Fold' s a -> 'Fold' s [a] -- @-splittingWhen :: (Applicative f, Gettable f, Eq a) => (a -> Bool) -> Getting [a] s s a a -> LensLike f s s [a] [a]+splittingWhen :: (Applicative f, Gettable f, Eq a) => (a -> Bool) -> Getting (Endo [a]) s s a a -> LensLike f s s [a] [a] splittingWhen s l f = coerce . traverse f . splitWhen s . toListOf l {-# INLINE splittingWhen #-} @@ -94,7 +95,7 @@ -- @ -- 'endingBy' :: 'Eq' a => [a] -> 'Fold' s a -> 'Fold' s [a] -- @-endingBy :: (Applicative f, Gettable f, Eq a) => [a] -> Getting [a] s s a a -> LensLike f s s [a] [a]+endingBy :: (Applicative f, Gettable f, Eq a) => [a] -> Getting (Endo [a]) s s a a -> LensLike f s s [a] [a] endingBy s l f = coerce . traverse f . endBy s . toListOf l {-# INLINE endingBy #-} @@ -105,7 +106,7 @@ -- @ -- 'endingByOneOf' :: 'Eq' a => [a] -> 'Fold' s a -> 'Fold' s [a] -- @-endingByOneOf :: (Applicative f, Gettable f, Eq a) => [a] -> Getting [a] s s a a -> LensLike f s s [a] [a]+endingByOneOf :: (Applicative f, Gettable f, Eq a) => [a] -> Getting (Endo [a]) s s a a -> LensLike f s s [a] [a] endingByOneOf s l f = coerce . traverse f . endByOneOf s . toListOf l {-# INLINE endingByOneOf #-} @@ -116,7 +117,7 @@ -- @ -- 'wordingBy' :: (a -> 'Bool') -> 'Fold' a -> 'Fold' s [a] -- @-wordingBy :: (Applicative f, Gettable f, Eq a) => (a -> Bool) -> Getting [a] s s a a -> LensLike f s s [a] [a]+wordingBy :: (Applicative f, Gettable f, Eq a) => (a -> Bool) -> Getting (Endo [a]) s s a a -> LensLike f s s [a] [a] wordingBy s l f = coerce . traverse f . wordsBy s . toListOf l {-# INLINE wordingBy #-} @@ -127,7 +128,7 @@ -- @ -- 'liningBy' :: (a -> 'Bool') -> 'Fold' s a -> 'Fold' s [a] -- @-liningBy :: (Applicative f, Gettable f, Eq a) => (a -> Bool) -> Getting [a] s s a a -> LensLike f s s [a] [a]+liningBy :: (Applicative f, Gettable f, Eq a) => (a -> Bool) -> Getting (Endo [a]) s s a a -> LensLike f s s [a] [a] liningBy s l f = coerce . traverse f . linesBy s . toListOf l {-# INLINE liningBy #-} @@ -137,7 +138,7 @@ -- 'chunkingOf' :: 'Int' -> 'Fold' s a -> 'Fold' s [a] -- @ chunking :: (Applicative f, Gettable f) => Int -- ^ @n@-            -> Getting [a] s s a a -> LensLike f s s [a] [a]+            -> Getting (Endo [a]) s s a a -> LensLike f s s [a] [a] chunking s l f = coerce . traverse f . chunksOf s . toListOf l {-# INLINE chunking #-} @@ -146,7 +147,7 @@ -- @ -- 'splittingPlaces' :: 'Integral' n => [n] -> 'Fold' s a -> 'Fold' s [a] -- @-splittingPlaces :: (Applicative f, Gettable f, Integral n) => [n] -> Getting [a] s s a a -> LensLike f s s [a] [a]+splittingPlaces :: (Applicative f, Gettable f, Integral n) => [n] -> Getting (Endo [a]) s s a a -> LensLike f s s [a] [a] splittingPlaces s l f = coerce . traverse f . splitPlaces s . toListOf l {-# INLINE splittingPlaces #-} @@ -155,7 +156,7 @@ -- @ -- 'splittingPlacesBlanks' :: 'Integral' n => [n] -> 'Fold' s a -> 'Fold' s [a] -- @-splittingPlacesBlanks :: (Applicative f, Gettable f, Integral n) => [n] -> Getting [a] s s a a -> LensLike f s s [a] [a]+splittingPlacesBlanks :: (Applicative f, Gettable f, Integral n) => [n] -> Getting (Endo [a]) s s a a -> LensLike f s s [a] [a] splittingPlacesBlanks s l f = coerce . traverse f . splitPlacesBlanks s . toListOf l {-# INLINE splittingPlacesBlanks #-} 

@@ -18,12 +18,14 @@ import Control.Lens import Control.Monad.State.Class as State +-- $setup+-- >>> :m + Control.Lens Data.Monoid.Lens Data.Foldable+ infixr 4 <>~, <<>~ infix 4 <>=, <<>=  -- | Modify the target of a monoidally valued by 'mappend'ing another value. ----- >>> :m + Control.Lens -- >>> both <>~ "!!!" $ ("hello","world") -- ("hello!!!","world!!!") --@@ -78,11 +80,9 @@  -- | Isomorphism for 'All' ----- >>> :m + Control.Lens Data.Monoid.Lens Data.Foldable -- >>> ala _all foldMap [True,True] -- True ----- >>> :m + Control.Lens Data.Monoid.Lens Data.Foldable -- >>> ala _all foldMap [True,False] -- False _all :: Simple Iso Bool All@@ -91,11 +91,9 @@  -- | Isomorphism for 'Any' ----- >>> :m + Control.Lens Data.Monoid.Lens Data.Foldable -- >>> ala _any foldMap [False,False] -- False ----- >>> :m + Control.Lens Data.Monoid.Lens Data.Foldable -- >>> ala _any foldMap [True,False] -- True _any :: Simple Iso Bool Any@@ -104,7 +102,6 @@  -- | Isomorphism for 'Sum' ----- >>> :m + Control.Lens Data.Monoid.Lens Data.Foldable -- >>> ala _sum foldMap [1,2,3,4] -- 10 _sum :: Iso a b (Sum a) (Sum b)@@ -113,7 +110,6 @@  -- | Isomorphism for 'Product' ----- >>> :m + Control.Lens Data.Monoid.Lens Data.Foldable -- >>> ala _product foldMap [1,2,3,4] -- 24 _product :: Iso a b (Product a) (Product b)

@@ -12,8 +12,8 @@ ---------------------------------------------------------------------------- module Data.Sequence.Lens   ( ordinal, viewL, viewR-  , traverseHead, traverseTail-  , traverseLast, traverseInit+  , _head, _tail+  , _last, _init   , traverseTo, traverseFrom   , traverseSlice   ) where@@ -56,32 +56,32 @@ -- * Traversals  -- | Traverse the head of a 'Seq'-traverseHead :: SimpleIndexedTraversal Int (Seq a) a-traverseHead = Lens.index $ \f m -> case viewl m of+_head :: SimpleIndexedTraversal Int (Seq a) a+_head = Lens.index $ \f m -> case viewl m of   a :< as -> (<| as) <$> f (0::Int) a   EmptyL  -> pure m-{-# INLINE traverseHead #-}+{-# INLINE _head #-}  -- | Traverse the tail of a 'Seq'-traverseTail :: SimpleIndexedTraversal Int (Seq a) a-traverseTail = Lens.index $ \f m -> case viewl m of-  a :< as -> (a <|) <$> itraverse (f . (+1)) as+_tail :: SimpleTraversal (Seq a) (Seq a)+_tail f m = case viewl m of+  a :< as -> (a <|) <$> f as   EmptyL  -> pure m-{-# INLINE traverseTail #-}+{-# INLINE _tail #-}  -- | Traverse the last element of a 'Seq'-traverseLast :: SimpleIndexedTraversal Int (Seq a) a-traverseLast = Lens.index $ \f m ->  case viewr m of+_last :: SimpleIndexedTraversal Int (Seq a) a+_last = Lens.index $ \f m ->  case viewr m of   as :> a -> (as |>) <$> f (Seq.length as) a   EmptyR  -> pure m-{-# INLINE traverseLast #-}+{-# INLINE _last #-}  -- | Traverse all but the last element of a 'Seq'-traverseInit :: SimpleIndexedTraversal Int (Seq a) a-traverseInit = Lens.index $ \ f m -> case viewr m of-  as :> a -> (|> a) <$> itraverse f as+_init :: SimpleTraversal (Seq a) (Seq a)+_init f m = case viewr m of+  as :> a -> (|> a) <$> f as   EmptyR  -> pure m-{-# INLINE traverseInit #-}+{-# INLINE _init #-}  -- | Traverse the first @n@ elements of a 'Seq' traverseTo :: Int -> SimpleIndexedTraversal Int (Seq a) a

@@ -36,11 +36,12 @@  import Control.Applicative import Control.Lens+import Data.List (nub)+import Data.Monoid import Data.Vector.Generic as V hiding (zip, filter) import Data.Vector.Fusion.Stream (Stream) import Data.Vector.Generic.New (New) import Prelude hiding ((++), length, head, tail, init, last, map, reverse)-import Data.List (nub)  -- $setup -- >>> import Data.Vector as Vector@@ -97,7 +98,7 @@ {-# INLINE sliced #-}  -- | Similar to 'toListOf', but returning a 'Vector'.-toVectorOf :: Vector v a => Getting [a] s t a b -> s -> v a+toVectorOf :: Vector v a => Getting (Endo [a]) s t a b -> s -> v a toVectorOf l s = fromList (toListOf l s) {-# INLINE toVectorOf #-} 

@@ -36,6 +36,7 @@ import Data.Vector as Vector hiding (zip, filter) import Prelude hiding ((++), length, head, tail, init, last, map, reverse) import Data.List (nub)+import Data.Monoid  -- | A lens reading and writing to the 'head' of a /non-empty/ 'Vector' --@@ -89,7 +90,7 @@ {-# INLINE sliced #-}  -- | Similar to 'toListOf', but returning a 'Vector'.-toVectorOf :: Getting [a] s t a b -> s -> Vector a+toVectorOf :: Getting (Endo [a]) s t a b -> s -> Vector a toVectorOf l s = fromList (toListOf l s) {-# INLINE toVectorOf #-} 

@@ -81,85 +81,85 @@   where test = use $ points.to last.to (vectorFrom origin).x  case_write_record_field =-  (trig % box.high.y .~ 6)-    @?= trig { _box = (trig % _box)-               { _high = (trig % _box % _high)+  (trig & box.high.y .~ 6)+    @?= trig { _box = (trig & _box)+               { _high = (trig & _box & _high)                          { _y = 6 } } }  case_write_state_record_field = do-  let trig' = trig { _box = (trig % _box)-                            { _high = (trig % _box % _high)+  let trig' = trig { _box = (trig & _box)+                            { _high = (trig & _box & _high)                                       { _y = 6 } } }   runState test trig @?= ((), trig')   where     test = box.high.y .= 6  case_write_record_field_and_access_new_value =-  (trig % box.high.y <.~ 6)-    @?= (6, trig { _box = (trig % _box)-                          { _high = (trig % _box % _high)+  (trig & box.high.y <.~ 6)+    @?= (6, trig { _box = (trig & _box)+                          { _high = (trig & _box & _high)                                     { _y = 6 } } })  case_write_state_record_field_and_access_new_value = do-  let trig' = trig { _box = (trig % _box)-                            { _high = (trig % _box % _high)+  let trig' = trig { _box = (trig & _box)+                            { _high = (trig & _box & _high)                                       { _y = 6 } } }   runState test trig @?= (6, trig')   where     test = box.high.y <.= 6  case_write_record_field_and_access_old_value =-  (trig % box.high.y <<.~ 6)-    @?= (7, trig { _box = (trig % _box)-                          { _high = (trig % _box % _high)+  (trig & box.high.y <<.~ 6)+    @?= (7, trig { _box = (trig & _box)+                          { _high = (trig & _box & _high)                                     { _y = 6 } } })  case_write_state_record_field_and_access_old_value = do-  let trig' = trig { _box = (trig % _box)-                            { _high = (trig % _box % _high)+  let trig' = trig { _box = (trig & _box)+                            { _high = (trig & _box & _high)                                       { _y = 6 } } }   runState test trig @?= (7, trig')   where     test = box.high.y <<.= 6  case_modify_record_field =-  (trig % box.low.y %~ (+ 2))-    @?= trig { _box = (trig % _box)-                      { _low = (trig % _box % _low)-                               { _y = ((trig % _box % _low % _y) + 2) } } }+  (trig & box.low.y %~ (+ 2))+    @?= trig { _box = (trig & _box)+                      { _low = (trig & _box & _low)+                               { _y = ((trig & _box & _low & _y) + 2) } } }  case_modify_state_record_field = do-  let trig' = trig { _box = (trig % _box)-                            { _low = (trig % _box % _low)-                                     { _y = ((trig % _box % _low % _y) + 2) } } }+  let trig' = trig { _box = (trig & _box)+                            { _low = (trig & _box & _low)+                                     { _y = ((trig & _box & _low & _y) + 2) } } }   runState test trig @?= ((), trig')   where     test = box.low.y %= (+ 2)  case_modify_record_field_and_access_new_value =-  (trig % box.low.y <%~ (+ 2))-    @?= (2, trig { _box = (trig % _box)-                          { _low = (trig % _box % _low)-                                   { _y = ((trig % _box % _low % _y) + 2) } } })+  (trig & box.low.y <%~ (+ 2))+    @?= (2, trig { _box = (trig & _box)+                          { _low = (trig & _box & _low)+                                   { _y = ((trig & _box & _low & _y) + 2) } } })  case_modify_state_record_field_and_access_new_value = do-  let trig' = trig { _box = (trig % _box)-                            { _low = (trig % _box % _low)-                                     { _y = ((trig % _box % _low % _y) + 2) } } }+  let trig' = trig { _box = (trig & _box)+                            { _low = (trig & _box & _low)+                                     { _y = ((trig & _box & _low & _y) + 2) } } }   runState test trig @?= (2, trig')   where     test = box.low.y <%= (+ 2)  case_modify_record_field_and_access_old_value =-  (trig % box.low.y <<%~ (+ 2))-    @?= (0, trig { _box = (trig % _box)-                          { _low = (trig % _box % _low)-                                   { _y = ((trig % _box % _low % _y) + 2) } } })+  (trig & box.low.y <<%~ (+ 2))+    @?= (0, trig { _box = (trig & _box)+                          { _low = (trig & _box & _low)+                                   { _y = ((trig & _box & _low & _y) + 2) } } })  case_modify_state_record_field_and_access_old_value = do-  let trig' = trig { _box = (trig % _box)-                            { _low = (trig % _box % _low)-                                     { _y = ((trig % _box % _low % _y) + 2) } } }+  let trig' = trig { _box = (trig & _box)+                            { _low = (trig & _box & _low)+                                     { _y = ((trig & _box & _low & _y) + 2) } } }   runState test trig @?= (0, trig')   where     test = box.low.y <<%= (+ 2)@@ -169,54 +169,54 @@   where     test = box.high %%= modifyAndCompute     modifyAndCompute point =-      (point ^. x, point % y +~ 2)-    trig' = trig { _box = (trig % _box)-                            { _high = (trig % _box % _high)-                                      { _y = ((trig % _box % _high % _y) + 2) } } }+      (point ^. x, point & y +~ 2)+    trig' = trig { _box = (trig & _box)+                            { _high = (trig & _box & _high)+                                      { _y = ((trig & _box & _high & _y) + 2) } } }  case_increment_record_field =-  (trig % box.low.y +~ 1) -- And similarly for -~ *~ //~ ^~ ^^~ **~ ||~ &&~-    @?= trig { _box = (trig % _box)-                      { _low = (trig % _box % _low)-                               { _y = ((trig % _box % _low % _y) + 1) } } }+  (trig & box.low.y +~ 1) -- And similarly for -~ *~ //~ ^~ ^^~ **~ ||~ &&~+    @?= trig { _box = (trig & _box)+                      { _low = (trig & _box & _low)+                               { _y = ((trig & _box & _low & _y) + 1) } } }  case_increment_state_record_field =   runState test trig @?= ((), trig')   where     test = box.low.y += 1-    trig' = trig { _box = (trig % _box)-                   { _low = (trig % _box % _low)-                     { _y = ((trig % _box % _low % _y) + 1) } } }+    trig' = trig { _box = (trig & _box)+                   { _low = (trig & _box & _low)+                     { _y = ((trig & _box & _low & _y) + 1) } } }  case_append_to_record_field =-  (trig % points <>~ [ origin ])-    @?= trig { _points = (trig % _points) <> [ origin ] }+  (trig & points <>~ [ origin ])+    @?= trig { _points = (trig & _points) <> [ origin ] }  case_append_to_state_record_field = do   runState test trig @?= ((), trig')   where     test = points <>= [ origin ]-    trig' = trig { _points = (trig % _points) <> [ origin ] }+    trig' = trig { _points = (trig & _points) <> [ origin ] }  case_append_to_record_field_and_access_new_value =-  (trig % points <<>~ [ origin ])-    @?= (_points trig <> [ origin ], trig { _points = (trig % _points) <> [ origin ] })+  (trig & points <<>~ [ origin ])+    @?= (_points trig <> [ origin ], trig { _points = (trig & _points) <> [ origin ] })  case_append_to_state_record_field_and_access_new_value = do   runState test trig @?= (_points trig <> [ origin ], trig')   where     test = points <<>= [ origin ]-    trig' = trig { _points = (trig % _points) <> [ origin ] }+    trig' = trig { _points = (trig & _points) <> [ origin ] }  case_append_to_record_field_and_access_old_value =-  (trig % points <<%~ (<>[origin]))-    @?= (_points trig, trig { _points = (trig % _points) <> [ origin ] })+  (trig & points <<%~ (<>[origin]))+    @?= (_points trig, trig { _points = (trig & _points) <> [ origin ] })  case_append_to_state_record_field_and_access_old_value = do   runState test trig @?= (_points trig, trig')   where     test = points <<%= (<>[origin])-    trig' = trig { _points = (trig % _points) <> [ origin ] }+    trig' = trig { _points = (trig & _points) <> [ origin ] }  case_read_maybe_map_entry = trig^.labels.at origin @?= Just "Origin" @@ -230,18 +230,18 @@   where test = use $ labels.traverseAt origin  case_modify_map_entry =-  (trig % labels.traverseAt origin %~ List.map toUpper)+  (trig & labels.traverseAt origin %~ List.map toUpper)     @?= trig { _labels = fromList [ (Point { _x = 0, _y = 0 }, "ORIGIN")                                   , (Point { _x = 4, _y = 7 }, "Peak") ] }  case_insert_maybe_map_entry =-  (trig % labels.at (Point { _x = 8, _y = 0 }) .~ Just "Right")+  (trig & labels.at (Point { _x = 8, _y = 0 }) .~ Just "Right")     @?= trig { _labels = fromList [ (Point { _x = 0, _y = 0 }, "Origin")                                   , (Point { _x = 4, _y = 7 }, "Peak")                                   , (Point { _x = 8, _y = 0 }, "Right") ] }  case_delete_maybe_map_entry =-  (trig % labels.at origin .~ Nothing)+  (trig & labels.at origin .~ Nothing)     @?= trig { _labels = fromList [ (Point { _x = 4, _y = 7 }, "Peak") ] }  case_read_list_entry =@@ -249,13 +249,13 @@     @?= origin  case_write_list_entry =-  (trig % points.element 0 .~ Point { _x = 2, _y = 0 })+  (trig & points.element 0 .~ Point { _x = 2, _y = 0 })     @?= trig { _points = [ Point { _x = 2, _y = 0 }                          , Point { _x = 4, _y = 7 }                          , Point { _x = 8, _y = 0 } ] }  case_write_through_list_entry =-  (trig % points.element 0 . x .~ 2)+  (trig & points.element 0 . x .~ 2)     @?= trig { _points = [ Point { _x = 2, _y = 0 }                          , Point { _x = 4, _y = 7 }                          , Point { _x = 8, _y = 0 } ] }