lens 0.4 → 0.5
raw patch · 4 files changed
+274/−46 lines, 4 filesdep ~base
Dependency ranges changed: base
Files
- lens.cabal +6/−3
- src/Control/Lens.hs +258/−41
- src/Control/Lens/Rep.hs +5/−1
- src/Control/Lens/TH.hs +5/−1
lens.cabal view
@@ -1,6 +1,6 @@ name: lens category: Data, Lenses-version: 0.4+version: 0.5 license: BSD3 cabal-version: >= 1.6 license-file: LICENSE@@ -13,6 +13,7 @@ synopsis: Lenses and Lens Families description: Lenses and Lens Families build-type: Simple+tested-with: GHC == 7.4.1 extra-source-files: .travis.yml source-repository head@@ -34,8 +35,10 @@ template-haskell >= 2.4 && < 2.8, transformers >= 0.2 && < 0.4 other-extensions:+ CPP Rank2Types RankNTypes- Safe TemplateHaskell- Trustworthy+ if (impl(ghc>=7.4))+ other-extensions:+ Safe Trustworthy
src/Control/Lens.hs view
@@ -1,4 +1,8 @@-{-# LANGUAGE Rank2Types, Safe #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE Rank2Types #-}+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 704+{-# LANGUAGE Safe #-}+#endif ----------------------------------------------------------------------------- -- | -- Module : Control.Lens@@ -25,7 +29,8 @@ -- -- This package provides lenses, lens families, setters, setter families, -- getters, traversals, folds, and traversal families in such--- a way that they can all be composed automatically with @(.)@.+-- a way that they can all be composed automatically with @(.)@ from+-- Prelude. -- -- You can derive lenses automatically for many data types: --@@ -56,20 +61,22 @@ -- ** Getting Values , reading+ , readings , (^.), (^$) -- * Setters , Setter, SetterFamily , setting+ , mapped -- ** Setting Values , modifying , writing- , (^%=), (^=), (^+=), (^-=), (^*=), (^/=), (^||=), (^&&=)+ , (^%=), (^=), (^+=), (^-=), (^*=), (^/=), (^||=), (^&&=), (^|=), (^&=) -- * Manipulating State , access- , (%=), (~=), (+=), (-=), (*=), (//=), (||=), (&&=)+ , (%=), (~=), (+=), (-=), (*=), (//=), (||=), (&&=), (|=), (&=) , (%%=) , Focus(..) @@ -111,31 +118,48 @@ -- ** Common Traversals , traverseNothing+ , traverseValueAt , traverseValueAtInt- , traverseHead- , traverseTail++ , traverseHead, traverseTail+ , traverseLast, traverseInit+ , traverseLeft , traverseRight+ , traverseElement+ , traverseElements+ , TraverseByteString(..) + , TraverseValueAtMin(..)+ , TraverseValueAtMax(..)++ , traverseBits+ -- ** Traversal Combinators- , traverseOf+ -- , traverseOf = id , mapMOf , sequenceAOf , sequenceOf+ , elementOf+ , elementsOf+ , transposeOf -- ** Common Lenses , _1 , _2 , valueAt , valueAtInt+ , bitAt , contains , containsInt , identity , resultAt + -- , indexOf+ -- * Implementation details , IndexedStore , Focusing@@ -148,6 +172,7 @@ import qualified Control.Monad.Trans.State.Lazy as Lazy import qualified Control.Monad.Trans.State.Strict as Strict import Control.Monad.Trans.Reader+import Data.Bits import Data.ByteString.Lazy as Lazy import Data.ByteString as Strict import Data.Foldable as Foldable@@ -156,13 +181,14 @@ import Data.IntSet as IntSet import Data.Map as Map import Data.Monoid+import Data.Sequence as Seq import Data.Set as Set import Data.Traversable import Data.Word (Word8) infixl 8 ^.-infixr 4 ^%=, ^=, ^+=, ^*=, ^-=, ^/=, ^&&=, ^||=-infix 4 ~=, %=, %%=, +=, -=, *=, //=, &&=, ||=+infixr 4 ^%=, ^=, ^+=, ^*=, ^-=, ^/=, ^&&=, ^||=, ^&=, ^|=+infix 4 ~=, %=, %%=, +=, -=, *=, //=, &&=, ||=, &=, |= infixr 0 ^$ --------------------------@@ -181,7 +207,6 @@ -- Every 'Lens' can be used directly as a 'LensFamily' or as a 'Getter', 'Setter', or 'Traversal', which transitively mens it can be used as -- almost anything! Such as a 'TraversalFamily', a 'GetterFamily', a 'FoldFamily', a 'Fold', or a 'SetterFamily'. ----- -- Example: -- -- > import Data.Complex@@ -243,8 +268,9 @@ type Getter a b = forall z. (b -> Const z b) -> a -> Const z a -- | A 'GetterFamily' describes how to retrieve a single value in a way that can be composed with--- other lens-like constructions. It can be used directly as a 'FoldFamily', since it just--- ignores the 'Monoid'.+-- other lens-like constructions.+--+-- A 'GetterFamily' can be used directly as a 'FoldFamily', since it just ignores the 'Monoid'. type GetterFamily a b c d = forall z. (c -> Const z d) -> a -> Const z b -- | Build a 'Getter' or 'GetterFamily'@@ -265,6 +291,13 @@ reading l a = getConst (l Const a) {-# INLINE reading #-} +-- | Get the value of a 'Getter', 'Lens' or 'LensFamily' or the fold of a+-- 'Fold', 'Traversal' or 'TraversalFamily' that points to something you want+-- to map to a monoidal value+readings :: ((c -> Const m d) -> a -> Const m b) -> (c -> m) -> a -> m+readings l f = getConst . l (Const . f)+{-# INLINE readings #-}+ -- | Read the value of a 'Getter', 'Lens' or 'LensFamily'. -- This is the same operation as 'reading'. (^$) :: ((c -> Const c d) -> a -> Const c b) -> a -> c@@ -318,6 +351,11 @@ setting f g a = Identity (f (runIdentity . g) a) {-# INLINE setting #-} +-- | This setter will replace all of the values in a container.+mapped :: Functor f => SetterFamily (f a) (f b) a b+mapped = setting fmap+{-# INLINE mapped #-}+ -- | Modify the target of a 'Lens', 'LensFamily' or all the targets of a -- 'Traversal', 'TraversalFamily', 'Setter' or 'SetterFamily' --@@ -411,27 +449,41 @@ l ^&&= n = modifying l (&& n) {-# INLINE (^&&=) #-} +-- | Bitwise '.|.' the target(s) of a 'Bool'-valued 'Lens' or 'Setter'+--+-- > (^|=):: Bits b => ((b -> Identity b) -> a -> Identity a) -> Bool -> a -> a+(^|=):: Bits b => Setter a b -> b -> a -> a+l ^|= n = modifying l (.|. n)+{-# INLINE (^|=) #-}++-- | Bitwise '.&.' the target(s) of a 'Bool'-valued 'Lens' or 'Setter'+-- (^&=) :: Bits b => ((b -> Identity b) -> a -> Identity a) -> b -> a -> a+(^&=) :: Bits b => Setter a b -> b -> a -> a+l ^&= n = modifying l (.&. n)+{-# INLINE (^&=) #-}+ ------------------------------------------------------------------------------ -- Common Lenses ------------------------------------------------------------------------------ -- | This is a lens family that can change the value (and type) of the first field of -- a pair.-+-- -- > ghci> (1,2)^._1 -- > 1 -- -- > ghci> _1 ^= "hello" $ (1,2) -- > ("hello",2) ----- > anyOf _2 :: (c -> Bool) -> (a, c) -> Bool--- > traverse._2 :: (Applicative f, Traversable t) => (a -> f b) -> t (c, a) -> f (t (c, b))--- > foldMapOf (traverse._2) :: (Traversable t, Monoid m) => (c -> m) -> t (b, c) -> m _1 :: LensFamily (a,c) (b,c) a b _1 f (a,c) = (\b -> (b,c)) <$> f a {-# INLINE _1 #-} -- | As '_1', but for the second field of a pair.+--+-- > anyOf _2 :: (c -> Bool) -> (a, c) -> Bool+-- > traverse._2 :: (Applicative f, Traversable t) => (a -> f b) -> t (c, a) -> f (t (c, b))+-- > foldMapOf (traverse._2) :: (Traversable t, Monoid m) => (c -> m) -> t (b, c) -> m _2 :: LensFamily (c,a) (c,b) a b _2 f (c,a) = (,) c <$> f a {-# INLINE _2 #-}@@ -459,7 +511,6 @@ go (Just v') = IntMap.insert k v' m {-# INLINE valueAtInt #-} - -- | This lens can be used to read, write or delete a member of a 'Set' -- -- > ghci> contains 3 ^= False $ Set.fromList [1,2,3,4]@@ -485,6 +536,10 @@ identity f (Identity a) = Identity <$> f a {-# INLINE identity #-} +bitAt :: Bits b => Int -> Lens b Bool+bitAt n f b = (\x -> if x then setBit b n else clearBit b n) <$> f (testBit b n)+{-# INLINE bitAt #-}+ -- | This lens can be used to change the result of a function but only where -- the arguments match the key given. --@@ -579,6 +634,16 @@ l ||= b = modify $ l ^||= b {-# INLINE (||=) #-} +-- | Modify a numeric field in our monadic state by computing its bitwise '.&.' with another value.+(&=):: (MonadState a m, Bits b) => Setter a b -> b -> m ()+l &= b = modify $ l ^&= b+{-# INLINE (&=) #-}++-- | Modify a boolean field in our monadic state by computing its bitwise '.|.' with another value.+(|=) :: (MonadState a m, Bits b) => Setter a b -> b -> m ()+l |= b = modify $ l ^|= b+{-# INLINE (|=) #-}+ -------------------------- -- Folds --------------------------@@ -610,28 +675,35 @@ {-# INLINE folding #-} ----------------------------- Fold combinators+-- Fold/Getter combinators -------------------------- -- | -- > foldMap = foldMapOf folded --+-- > foldMapOf = readings+--+-- > foldMapOf :: GetterFamily a b c d -> (c -> m) -> a -> m -- > foldMapOf :: Monoid m => FoldFamily a b c d -> (c -> m) -> a -> m-foldMapOf :: Monoid m => ((c -> Const m d) -> a -> Const m b) -> (c -> m) -> a -> m+foldMapOf :: ((c -> Const m d) -> a -> Const m b) -> (c -> m) -> a -> m foldMapOf l f = getConst . l (Const . f) {-# INLINE foldMapOf #-} -- | -- > fold = foldOf folded --+-- > foldOf = reading+--+-- > foldOf :: GetterFamily a b m d -> a -> m -- > foldOf :: Monoid m => FoldFamily a b m d -> a -> m-foldOf :: Monoid m => ((m -> Const m d) -> a -> Const m b) -> a -> m+foldOf :: ((m -> Const m d) -> a -> Const m b) -> a -> m foldOf l = getConst . l Const {-# INLINE foldOf #-} -- | -- > foldr = foldrOf folded --+-- > foldrOf :: GetterFamily a b c d -> (c -> e -> e) -> e -> a -> e -- > foldrOf :: FoldFamily a b c d -> (c -> e -> e) -> e -> a -> e foldrOf :: ((c -> Const (Endo e) d) -> a -> Const (Endo e) b) -> (c -> e -> e) -> e -> a -> e foldrOf l f z t = appEndo (foldMapOf l (Endo . f) t) z@@ -640,6 +712,7 @@ -- | -- > toList = toListOf folded --+-- > toListOf :: GetterFamily a b c d -> a -> [c] -- > toListOf :: FoldFamily a b c d -> a -> [c] toListOf :: ((c -> Const [c] d) -> a -> Const [c] b) -> a -> [c] toListOf l = foldMapOf l return@@ -648,6 +721,7 @@ -- | -- > and = andOf folded --+-- > andOf :: GetterFamily a b Bool d -> a -> Bool -- > andOf :: FoldFamily a b Bool d -> a -> Bool andOf :: ((Bool -> Const All d) -> a -> Const All b) -> a -> Bool andOf l = getAll . foldMapOf l All@@ -656,6 +730,7 @@ -- | -- > or = orOf folded --+-- > orOf :: GetterFamily a b Bool d -> a -> Bool -- > orOf :: FoldFamily a b Bool d -> a -> Bool orOf :: ((Bool -> Const Any d) -> a -> Const Any b) -> a -> Bool orOf l = getAny . foldMapOf l Any@@ -664,6 +739,7 @@ -- | -- > any = anyOf folded --+-- > anyOf :: GetterFamily a b c d -> (c -> Bool) -> a -> Bool -- > anyOf :: FoldFamily a b c d -> (c -> Bool) -> a -> Bool anyOf :: ((c -> Const Any d) -> a -> Const Any b) -> (c -> Bool) -> a -> Bool anyOf l f = getAny . foldMapOf l (Any . f)@@ -672,6 +748,7 @@ -- | -- > all = allOf folded --+-- > allOf :: GetterFamily a b c d -> (c -> Bool) -> a -> Bool -- > allOf :: FoldFamily a b c d -> (c -> Bool) -> a -> Bool allOf :: ((c -> Const All d) -> a -> Const All b) -> (c -> Bool) -> a -> Bool allOf l f = getAll . foldMapOf l (All . f)@@ -680,46 +757,65 @@ -- | -- > product = productOf folded ----- > productOf :: Num c => FoldFamily a b c d -> a -> c-productOf :: Num c => ((c -> Const (Product c) d) -> a -> Const (Product c) b) -> a -> c+-- > productOf :: GetterFamily a b c d -> a -> c+-- > productOf :: Num c => FoldFamily a b c d -> a -> c+productOf :: ((c -> Const (Product c) d) -> a -> Const (Product c) b) -> a -> c productOf l = getProduct . foldMapOf l Product {-# INLINE productOf #-} -- | -- > sum = sumOf folded ----- > sumOf :: Num c => FoldFamily a b c d -> a -> c-sumOf :: Num c => ((c -> Const (Sum c) d) -> a -> Const (Sum c) b) -> a -> c+-- > sumOf _1 :: (a, b) -> a+-- > sumOf (folded._1) :: (Foldable f, Num a) => f (a, b) -> a+--+-- > sumOf :: GetterFamily a b c d -> a -> c+-- > sumOf :: Num c => FoldFamily a b c d -> a -> c+sumOf :: ((c -> Const (Sum c) d) -> a -> Const (Sum c) b) -> a -> c sumOf l = getSum . foldMapOf l Sum {-# INLINE sumOf #-} -- |+--+-- When passed a 'Getter', 'traverseOf_' can work over a 'Functor'.+--+-- When passed a 'FoldFamily', 'traverseOf_' requires an 'Applicative'.+-- -- > traverse_ = traverseOf_ folded++-- > traverseOf_ _2 :: Functor f => (c -> f e) -> (c1, c) -> f ()+-- > traverseOf_ traverseLeft :: Applicative f => (a -> f b) -> Either a c -> f () --+-- The rather specific signature of traverseOf_ allows it to be used as if the signature was either:+--+-- > traverseOf_ :: Functor f => GetterFamily a b c d -> (c -> f e) -> a -> f () -- > traverseOf_ :: Applicative f => FoldFamily a b c d -> (c -> f e) -> a -> f ()-traverseOf_ :: Applicative f => ((c -> Const (Traversed f) d) -> a -> Const (Traversed f) b) -> (c -> f e) -> a -> f ()+traverseOf_ :: Functor f => ((c -> Const (Traversed f) d) -> a -> Const (Traversed f) b) -> (c -> f e) -> a -> f () traverseOf_ l f = getTraversed . foldMapOf l (Traversed . (() <$) . f) {-# INLINE traverseOf_ #-} -- | -- > for_ = forOf_ folded --+-- > forOf_ :: Functor f => GetterFamily a b c d -> a -> (c -> f e) -> f () -- > forOf_ :: Applicative f => FoldFamily a b c d -> a -> (c -> f e) -> f ()-forOf_ :: Applicative f => ((c -> Const (Traversed f) d) -> a -> Const (Traversed f) b) -> a -> (c -> f e) -> f ()+forOf_ :: Functor f => ((c -> Const (Traversed f) d) -> a -> Const (Traversed f) b) -> a -> (c -> f e) -> f () forOf_ l a f = traverseOf_ l f a {-# INLINE forOf_ #-} -- | -- > sequenceA_ = sequenceAOf_ folded --+-- > sequenceAOf_ :: Functor f => GetterFamily a b (f ()) d -> a -> f () -- > sequenceAOf_ :: Applicative f => FoldFamily a b (f ()) d -> a -> f ()-sequenceAOf_ :: Applicative f => ((f () -> Const (Traversed f) d) -> a -> Const (Traversed f) b) -> a -> f ()+sequenceAOf_ :: Functor f => ((f () -> Const (Traversed f) d) -> a -> Const (Traversed f) b) -> a -> f () sequenceAOf_ l = getTraversed . foldMapOf l (Traversed . (() <$)) {-# INLINE sequenceAOf_ #-} -- | -- > mapM_ = mapMOf_ folded --+-- > mapMOf_ :: Monad m => GetterFamily a b c d -> (c -> m e) -> a -> m () -- > mapMOf_ :: Monad m => FoldFamily a b c d -> (c -> m e) -> a -> m () mapMOf_ :: Monad m => ((c -> Const (Traversed (WrappedMonad m)) d) -> a -> Const (Traversed (WrappedMonad m)) b) -> (c -> m e) -> a -> m () mapMOf_ l f = unwrapMonad . traverseOf_ l (WrapMonad . f)@@ -728,6 +824,7 @@ -- | -- > forM_ = forMOf_ folded --+-- > forMOf_ :: Monad m => GetterFamily a b c d -> a -> (c -> m e) -> m () -- > forMOf_ :: Monad m => FoldFamily a b c d -> a -> (c -> m e) -> m () forMOf_ :: Monad m => ((c -> Const (Traversed (WrappedMonad m)) d) -> a -> Const (Traversed (WrappedMonad m)) b) -> a -> (c -> m e) -> m () forMOf_ l a f = mapMOf_ l f a@@ -736,6 +833,7 @@ -- | -- > sequence_ = sequenceOf_ folded --+-- > sequenceOf_ :: Monad m => GetterFamily a b (m b) d -> a -> m () -- > sequenceOf_ :: Monad m => FoldFamily a b (m b) d -> a -> m () sequenceOf_ :: Monad m => ((m c -> Const (Traversed (WrappedMonad m)) d) -> a -> Const (Traversed (WrappedMonad m)) b) -> a -> m () sequenceOf_ l = unwrapMonad . traverseOf_ l WrapMonad@@ -745,6 +843,7 @@ -- -- > asum = asumOf folded --+-- > asumOf :: Alternative f => GetterFamily a b c d -> a -> f c -- > asumOf :: Alternative f => FoldFamily a b c d -> a -> f c asumOf :: Alternative f => ((f c -> Const (Endo (f c)) d) -> a -> Const (Endo (f c)) b) -> a -> f c asumOf l = foldrOf l (<|>) Applicative.empty@@ -754,6 +853,7 @@ -- -- > msum = msumOf folded --+-- > msumOf :: MonadPlus m => GetterFamily a b c d -> a -> m c -- > msumOf :: MonadPlus m => FoldFamily a b c d -> a -> m c msumOf :: MonadPlus m => ((m c -> Const (Endo (m c)) d) -> a -> Const (Endo (m c)) b) -> a -> m c msumOf l = foldrOf l mplus mzero@@ -762,6 +862,7 @@ -- | -- > elem = elemOf folded --+-- > elemOf :: Eq c => GetterFamily a b c d -> c -> a -> Bool -- > elemOf :: Eq c => FoldFamily a b c d -> c -> a -> Bool elemOf :: Eq c => ((c -> Const Any d) -> a -> Const Any b) -> c -> a -> Bool elemOf l = anyOf l . (==)@@ -770,6 +871,7 @@ -- | -- > notElem = notElemOf folded --+-- > notElemOf :: Eq c => GetterFamily a b c d -> c -> a -> Bool -- > notElemOf :: Eq c => FoldFamily a b c d -> c -> a -> Bool notElemOf :: Eq c => ((c -> Const Any d) -> a -> Const Any b) -> c -> a -> Bool notElemOf l c = not . elemOf l c@@ -778,6 +880,7 @@ -- | -- > concatMap = concatMapOf folded --+-- > concatMapOf :: GetterFamily a b c d -> (c -> [e]) -> a -> [e] -- > concatMapOf :: FoldFamily a b c d -> (c -> [e]) -> a -> [e] concatMapOf :: ((c -> Const [e] d) -> a -> Const [e] b) -> (c -> [e]) -> a -> [e] concatMapOf l ces a = getConst (l (Const . ces) a)@@ -786,6 +889,7 @@ -- | -- > concat = concatOf folded --+-- > concatOf :: GetterFamily a b [e] d -> a -> [e] -- > concatOf :: FoldFamily a b [e] d -> a -> [e] concatOf :: (([e] -> Const [e] d) -> a -> Const [e] b) -> a -> [e] concatOf = reading@@ -817,25 +921,18 @@ -------------------------- -- |--- > traverseOf = id--- > traverse = traverseOf traverse------ > traverseOf :: Applicative f => TraversalFamily a b c d -> (c -> f d) -> a -> f b-traverseOf :: Applicative f => ((c -> f d) -> a -> f b) -> (c -> f d) -> a -> f b-traverseOf = id-{-# INLINE traverseOf #-}---- | -- > mapM = mapMOf traverse --+-- > mapMOf :: Monad m => LensFamily a b c d -> (c -> m d) -> a -> m b -- > mapMOf :: Monad m => TraversalFamily a b c d -> (c -> m d) -> a -> m b-mapMOf :: Monad m => ((c -> WrappedMonad m d) -> a -> WrappedMonad m b) -> (c -> m d) -> a -> m b+mapMOf :: ((c -> WrappedMonad m d) -> a -> WrappedMonad m b) -> (c -> m d) -> a -> m b mapMOf l cmd a = unwrapMonad (l (WrapMonad . cmd) a) {-# INLINE mapMOf #-} -- | -- > sequenceA = sequenceAOf traverse --+-- > sequenceAOf :: Applicative f => LensFamily a b (f c) (f c) -> a -> f b -- > sequenceAOf :: Applicative f => TraversalFamily a b (f c) (f c) -> a -> f b sequenceAOf :: Applicative f => ((f c -> f (f c)) -> a -> f b) -> a -> f b sequenceAOf l = l pure@@ -844,11 +941,35 @@ -- | -- > sequence = sequenceOf traverse --+-- > sequenceOf :: Monad m => LensFamily a b (m c) (m c) -> a -> m b -- > sequenceOf :: Monad m => TraversalFamily a b (m c) (m c) -> a -> m b sequenceOf :: Monad m => ((m c -> WrappedMonad m (m c)) -> a -> WrappedMonad m b) -> a -> m b sequenceOf l = unwrapMonad . l pure {-# INLINE sequenceOf #-} +-- | A Traversal of the nth element of a Traversal+--+-- > traverseHead = elementOf traverse 0+elementOf :: Applicative f => ((c -> SA f c) -> a -> SA f b) -> Int -> (c -> f c) -> a -> f b+elementOf l = elementsOf l . (==)++-- | A Traversal of the elements at positions in a Traversal where the positions satisfy a predicate+--+-- > traverseTail = elementsOf traverse (>0)+elementsOf :: Applicative f => ((c -> SA f c) -> a -> SA f b) -> (Int -> Bool) -> (c -> f c) -> a -> f b+elementsOf l p f ta = fst (runSA (l go ta) 0) where+ go a = SA $ \i -> (if p i then f a else pure a, i + 1)++-- |+--+-- > transpose = transposeOf traverse -- (for not ragged arrays)+--+--+-- > transposeOf _2 :: (b, [a]) -> [(b, a)]++transposeOf :: (([c] -> ZipList c) -> a -> ZipList b) -> a -> [b]+transposeOf l = getZipList . l ZipList+ -------------------------- -- Traversals --------------------------@@ -862,20 +983,42 @@ -- The traversal for reading and writing to the head of a list --+-- > traverseHead = traverseValueAtMin+-- > traverseHead = traverseElementAt 0 -- but is more efficient+-- -- | > traverseHead :: Applicative f => (a -> f a) -> [a] -> f [a] traverseHead :: Traversal [a] a traverseHead _ [] = pure [] traverseHead f (a:as) = (:as) <$> f a {-# INLINE traverseHead #-} --- The traversal for reading and writing to the tail of a list--- -- | > traverseTail :: Applicative f => ([a] -> f [a]) -> [a] -> f [a] traverseTail :: Traversal [a] [a] traverseTail _ [] = pure [] traverseTail f (a:as) = (a:) <$> f as {-# INLINE traverseTail #-} +-- | Traverse the last element in a list.+--+-- > traverseLast = traverseValueAtMax+--+-- > traverseLast :: Applicative f => (a -> f a) -> [a] -> f [a]+traverseLast :: Traversal [a] a+traverseLast _ [] = pure []+traverseLast f [a] = return <$> f a+traverseLast f (a:as) = (a:) <$> traverseLast f as+{-# INLINE traverseLast #-}++-- The traversal for reading and writing to the tail of a list++-- | Traverse all but the last element of a list+--+-- > traverseInit :: Applicative f => ([a] -> f [a]) -> [a] -> f [a]+traverseInit :: Traversal [a] [a]+traverseInit _ [] = pure []+traverseInit f as = (++ [Prelude.last as]) <$> f (Prelude.init as)+{-# INLINE traverseInit #-}+ -- | A traversal for tweaking the left-hand value in an Either: -- -- > traverseLeft :: Applicative f => (a -> f b) -> Either a c -> f (Either b c)@@ -916,10 +1059,18 @@ -- -- > traverseElement :: (Applicative f, Traversable t) => Int -> (a -> f a) -> t a -> f (t a) traverseElement :: Traversable t => Int -> Traversal (t a) a-traverseElement j f ta = fst (runSA (traverse go ta) 0) where- go a = SA $ \i -> (if i == j then f a else pure a, i + 1)+traverseElement = traverseElements . (==) {-# INLINE traverseElement #-} +-- | Traverse elements where a predicate holds on their position in a traversable container+--+-- > traverseElements :: Applicative f, Traversable t) => (Int -> Bool) -> (a -> f a) -> t a -> f (t a)+traverseElements :: Traversable t => (Int -> Bool) -> Traversal (t a) a+traverseElements p f ta = fst (runSA (traverse go ta) 0) where+ go a = SA $ \i -> (if p i then f a else pure a, i + 1)+{-# INLINE traverseElements #-}++ class TraverseByteString t where -- | Traverse the individual bytes in a ByteString --@@ -932,6 +1083,66 @@ instance TraverseByteString Lazy.ByteString where traverseByteString f = fmap Lazy.pack . traverse f . Lazy.unpack +class TraverseValueAtMin t where+ traverseValueAtMin :: Traversal (t v) v+ -- default traverseValueAtMin :: Traversable t => Traversal (t v) v+ -- traverseValueAtMin = traverseElement 0++instance TraverseValueAtMin (Map k) where+ traverseValueAtMin f m = case Map.minView m of+ Just (a, _) -> (\v -> Map.updateMin (const (Just v)) m) <$> f a+ Nothing -> pure m++instance TraverseValueAtMin IntMap where+ traverseValueAtMin f m = case IntMap.minView m of+ Just (a, _) -> (\v -> IntMap.updateMin (const v) m) <$> f a+ Nothing -> pure m++instance TraverseValueAtMin [] where+ traverseValueAtMin = traverseHead++instance TraverseValueAtMin Seq where+ traverseValueAtMin f m = case Seq.viewl m of+ a :< as -> (<| as) <$> f a+ EmptyL -> pure m++class TraverseValueAtMax t where+ traverseValueAtMax :: Traversal (t v) v++instance TraverseValueAtMax (Map k) where+ traverseValueAtMax f m = case Map.maxView m of+ Just (a, _) -> (\v -> Map.updateMax (const (Just v)) m) <$> f a+ Nothing -> pure m++instance TraverseValueAtMax IntMap where+ traverseValueAtMax f m = case IntMap.maxView m of+ Just (a, _) -> (\v -> IntMap.updateMax (const v) m) <$> f a+ Nothing -> pure m++instance TraverseValueAtMax [] where+ traverseValueAtMax = traverseLast++instance TraverseValueAtMax Seq where+ traverseValueAtMax f m = case Seq.viewr m of+ as :> a -> (as |>) <$> f a+ EmptyR -> pure m++traverseBits :: Bits b => Traversal b Bool+traverseBits f b = Prelude.foldr step 0 <$> traverse g bits+ where+ g n = (,) n <$> f (testBit b n)+ bits = Prelude.takeWhile hasBit [0..]+ hasBit n = complementBit b n /= b -- test to make sure that complementing this bit actually changes the value+ step (n,True) r = setBit r n+ step _ r = r++-- this version requires a legal bitSize+--+--traverseBits :: Bits b => Traversal b Bool+--traverseBits f b = snd . Prelude.foldr step (bitSize b - 1,0) <$> traverse (f . testBit b) [0 .. bitSize b - 1] where+-- step True (n,r) = (n - 1, setBit r n)+-- step _ (n,r) = (n - 1, r)+ ------------------------------------------------------------------------------ -- Cloning Lenses ------------------------------------------------------------------------------@@ -945,6 +1156,12 @@ clone f cfd a = case f (IndexedStore id) a of IndexedStore db c -> db <$> cfd c {-# INLINE clone #-}++--indexOf :: ((c -> ((e -> Const e d) -> c -> Const e b) -> e) ->+-- a -> ((e -> Const e d) -> c -> Const e b) -> e) ->+-- a -> ((e -> Const e d) -> c -> Const e b) -> e+--indexOf l = l (^.)+--{-# INLINE indexOf #-} ------------------------------------------------------------------------------ -- Implementation details
src/Control/Lens/Rep.hs view
@@ -1,4 +1,8 @@-{-# LANGUAGE RankNTypes, Safe #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE RankNTypes #-}+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 704+{-# LANGUAGE Safe #-}+#endif ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.Rep
src/Control/Lens/TH.hs view
@@ -1,4 +1,8 @@-{-# LANGUAGE TemplateHaskell, Trustworthy #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-}+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 704+{-# LANGUAGE Trustworthy #-}+#endif ----------------------------------------------------------------------------- -- | -- Module : Control.Lens.TH