1{-# LANGUAGE CPP #-} 2{-# LANGUAGE Rank2Types #-} 3{-# LANGUAGE FlexibleContexts #-} 4{-# LANGUAGE FlexibleInstances #-} 5{-# LANGUAGE MultiParamTypeClasses #-} 6{-# LANGUAGE ConstraintKinds #-} 7{-# LANGUAGE Trustworthy #-} 8 9#include "lens-common.h" 10{-# OPTIONS_GHC -fno-warn-orphans #-} 11---------------------------------------------------------------------------- 12-- | 13-- Module : Control.Lens.Fold 14-- Copyright : (C) 2012-16 Edward Kmett 15-- License : BSD-style (see the file LICENSE) 16-- Maintainer : Edward Kmett <ekmett@gmail.com> 17-- Stability : provisional 18-- Portability : Rank2Types 19-- 20-- A @'Fold' s a@ is a generalization of something 'Foldable'. It allows 21-- you to extract multiple results from a container. A 'Foldable' container 22-- can be characterized by the behavior of 23-- @'Data.Foldable.foldMap' :: ('Foldable' t, 'Monoid' m) => (a -> m) -> t a -> m@. 24-- Since we want to be able to work with monomorphic containers, we could 25-- generalize this signature to @forall m. 'Monoid' m => (a -> m) -> s -> m@, 26-- and then decorate it with 'Const' to obtain 27-- 28-- @type 'Fold' s a = forall m. 'Monoid' m => 'Getting' m s a@ 29-- 30-- Every 'Getter' is a valid 'Fold' that simply doesn't use the 'Monoid' 31-- it is passed. 32-- 33-- In practice the type we use is slightly more complicated to allow for 34-- better error messages and for it to be transformed by certain 35-- 'Applicative' transformers. 36-- 37-- Everything you can do with a 'Foldable' container, you can with with a 'Fold' and there are 38-- combinators that generalize the usual 'Foldable' operations here. 39---------------------------------------------------------------------------- 40module Control.Lens.Fold 41 ( 42 -- * Folds 43 Fold 44 , IndexedFold 45 46 -- * Getting Started 47 , (^..) 48 , (^?) 49 , (^?!) 50 , pre, ipre 51 , preview, previews, ipreview, ipreviews 52 , preuse, preuses, ipreuse, ipreuses 53 54 , has, hasn't 55 56 -- ** Building Folds 57 , folding, ifolding 58 , foldring, ifoldring 59 , folded 60 , folded64 61 , unfolded 62 , iterated 63 , filtered 64 , filteredBy 65 , backwards 66 , repeated 67 , replicated 68 , cycled 69 , takingWhile 70 , droppingWhile 71 , worded, lined 72 73 -- ** Folding 74 , foldMapOf, foldOf 75 , foldrOf, foldlOf 76 , toListOf, toNonEmptyOf 77 , anyOf, allOf, noneOf 78 , andOf, orOf 79 , productOf, sumOf 80 , traverseOf_, forOf_, sequenceAOf_ 81 , traverse1Of_, for1Of_, sequence1Of_ 82 , mapMOf_, forMOf_, sequenceOf_ 83 , asumOf, msumOf 84 , concatMapOf, concatOf 85 , elemOf, notElemOf 86 , lengthOf 87 , nullOf, notNullOf 88 , firstOf, first1Of, lastOf, last1Of 89 , maximumOf, maximum1Of, minimumOf, minimum1Of 90 , maximumByOf, minimumByOf 91 , findOf 92 , findMOf 93 , foldrOf', foldlOf' 94 , foldr1Of, foldl1Of 95 , foldr1Of', foldl1Of' 96 , foldrMOf, foldlMOf 97 , lookupOf 98 99 -- * Indexed Folds 100 , (^@..) 101 , (^@?) 102 , (^@?!) 103 104 -- ** Indexed Folding 105 , ifoldMapOf 106 , ifoldrOf 107 , ifoldlOf 108 , ianyOf 109 , iallOf 110 , inoneOf 111 , itraverseOf_ 112 , iforOf_ 113 , imapMOf_ 114 , iforMOf_ 115 , iconcatMapOf 116 , ifindOf 117 , ifindMOf 118 , ifoldrOf' 119 , ifoldlOf' 120 , ifoldrMOf 121 , ifoldlMOf 122 , itoListOf 123 , elemIndexOf 124 , elemIndicesOf 125 , findIndexOf 126 , findIndicesOf 127 128 -- ** Building Indexed Folds 129 , ifiltered 130 , itakingWhile 131 , idroppingWhile 132 133 -- * Internal types 134 , Leftmost 135 , Rightmost 136 , Traversed 137 , Sequenced 138 139 -- * Fold with Reified Monoid 140 , foldBy 141 , foldByOf 142 , foldMapBy 143 , foldMapByOf 144 ) where 145 146import Prelude () 147 148import Control.Applicative.Backwards 149import Control.Comonad 150import Control.Lens.Getter 151import Control.Lens.Internal.Fold 152import Control.Lens.Internal.Getter 153import Control.Lens.Internal.Indexed 154import Control.Lens.Internal.Magma 155import Control.Lens.Internal.Prelude 156import Control.Lens.Type 157import Control.Monad as Monad 158import Control.Monad.Reader 159import Control.Monad.State 160import Data.CallStack 161import Data.Functor.Apply hiding ((<.)) 162import Data.Int (Int64) 163import Data.List (intercalate) 164import Data.Maybe (fromMaybe) 165import Data.Monoid (First (..), All (..), Any (..)) 166#if MIN_VERSION_reflection(2,1,0) 167import Data.Reflection 168#endif 169 170import qualified Data.Semigroup as Semi 171 172-- $setup 173-- >>> :set -XNoOverloadedStrings 174-- >>> import Control.Lens 175-- >>> import Control.Lens.Extras (is) 176-- >>> import Data.Function 177-- >>> import Data.List.Lens 178-- >>> import Debug.SimpleReflect.Expr 179-- >>> import Debug.SimpleReflect.Vars as Vars hiding (f,g) 180-- >>> import Control.DeepSeq (NFData (..), force) 181-- >>> import Control.Exception (evaluate) 182-- >>> import Data.Maybe (fromMaybe) 183-- >>> import Data.Monoid (Sum (..)) 184-- >>> import System.Timeout (timeout) 185-- >>> import qualified Data.Map as Map 186-- >>> let f :: Expr -> Expr; f = Debug.SimpleReflect.Vars.f 187-- >>> let g :: Expr -> Expr; g = Debug.SimpleReflect.Vars.g 188-- >>> let timingOut :: NFData a => a -> IO a; timingOut = fmap (fromMaybe (error "timeout")) . timeout (5*10^6) . evaluate . force 189 190#ifdef HLINT 191{-# ANN module "HLint: ignore Eta reduce" #-} 192{-# ANN module "HLint: ignore Use camelCase" #-} 193{-# ANN module "HLint: ignore Use curry" #-} 194{-# ANN module "HLint: ignore Use fmap" #-} 195#endif 196 197infixl 8 ^.., ^?, ^?!, ^@.., ^@?, ^@?! 198 199-------------------------- 200-- Folds 201-------------------------- 202 203-- | Obtain a 'Fold' by lifting an operation that returns a 'Foldable' result. 204-- 205-- This can be useful to lift operations from @Data.List@ and elsewhere into a 'Fold'. 206-- 207-- >>> [1,2,3,4]^..folding tail 208-- [2,3,4] 209folding :: Foldable f => (s -> f a) -> Fold s a 210folding sfa agb = phantom . traverse_ agb . sfa 211{-# INLINE folding #-} 212 213ifolding :: (Foldable f, Indexable i p, Contravariant g, Applicative g) => (s -> f (i, a)) -> Over p g s t a b 214ifolding sfa f = phantom . traverse_ (phantom . uncurry (indexed f)) . sfa 215{-# INLINE ifolding #-} 216 217-- | Obtain a 'Fold' by lifting 'foldr' like function. 218-- 219-- >>> [1,2,3,4]^..foldring foldr 220-- [1,2,3,4] 221foldring :: (Contravariant f, Applicative f) => ((a -> f a -> f a) -> f a -> s -> f a) -> LensLike f s t a b 222foldring fr f = phantom . fr (\a fa -> f a *> fa) noEffect 223{-# INLINE foldring #-} 224 225-- | Obtain 'FoldWithIndex' by lifting 'ifoldr' like function. 226ifoldring :: (Indexable i p, Contravariant f, Applicative f) => ((i -> a -> f a -> f a) -> f a -> s -> f a) -> Over p f s t a b 227ifoldring ifr f = phantom . ifr (\i a fa -> indexed f i a *> fa) noEffect 228{-# INLINE ifoldring #-} 229 230-- | Obtain a 'Fold' from any 'Foldable' indexed by ordinal position. 231-- 232-- >>> Just 3^..folded 233-- [3] 234-- 235-- >>> Nothing^..folded 236-- [] 237-- 238-- >>> [(1,2),(3,4)]^..folded.both 239-- [1,2,3,4] 240folded :: Foldable f => IndexedFold Int (f a) a 241folded = conjoined (foldring foldr) (ifoldring ifoldr) 242{-# INLINE folded #-} 243 244ifoldr :: Foldable f => (Int -> a -> b -> b) -> b -> f a -> b 245ifoldr f z xs = foldr (\ x g i -> i `seq` f i x (g (i+1))) (const z) xs 0 246{-# INLINE ifoldr #-} 247 248-- | Obtain a 'Fold' from any 'Foldable' indexed by ordinal position. 249folded64 :: Foldable f => IndexedFold Int64 (f a) a 250folded64 = conjoined (foldring foldr) (ifoldring ifoldr64) 251{-# INLINE folded64 #-} 252 253ifoldr64 :: Foldable f => (Int64 -> a -> b -> b) -> b -> f a -> b 254ifoldr64 f z xs = foldr (\ x g i -> i `seq` f i x (g (i+1))) (const z) xs 0 255{-# INLINE ifoldr64 #-} 256 257-- | Form a 'Fold1' by repeating the input forever. 258-- 259-- @ 260-- 'repeat' ≡ 'toListOf' 'repeated' 261-- @ 262-- 263-- >>> timingOut $ 5^..taking 20 repeated 264-- [5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5] 265-- 266-- @ 267-- 'repeated' :: 'Fold1' a a 268-- @ 269repeated :: Apply f => LensLike' f a a 270repeated f a = as where as = f a .> as 271{-# INLINE repeated #-} 272 273-- | A 'Fold' that replicates its input @n@ times. 274-- 275-- @ 276-- 'replicate' n ≡ 'toListOf' ('replicated' n) 277-- @ 278-- 279-- >>> 5^..replicated 20 280-- [5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5] 281replicated :: Int -> Fold a a 282replicated n0 f a = go n0 where 283 m = f a 284 go 0 = noEffect 285 go n = m *> go (n - 1) 286{-# INLINE replicated #-} 287 288-- | Transform a non-empty 'Fold' into a 'Fold1' that loops over its elements over and over. 289-- 290-- >>> timingOut $ [1,2,3]^..taking 7 (cycled traverse) 291-- [1,2,3,1,2,3,1] 292-- 293-- @ 294-- 'cycled' :: 'Fold1' s a -> 'Fold1' s a 295-- @ 296cycled :: Apply f => LensLike f s t a b -> LensLike f s t a b 297cycled l f a = as where as = l f a .> as 298{-# INLINE cycled #-} 299 300-- | Build a 'Fold' that unfolds its values from a seed. 301-- 302-- @ 303-- 'Prelude.unfoldr' ≡ 'toListOf' '.' 'unfolded' 304-- @ 305-- 306-- >>> 10^..unfolded (\b -> if b == 0 then Nothing else Just (b, b-1)) 307-- [10,9,8,7,6,5,4,3,2,1] 308unfolded :: (b -> Maybe (a, b)) -> Fold b a 309unfolded f g b0 = go b0 where 310 go b = case f b of 311 Just (a, b') -> g a *> go b' 312 Nothing -> noEffect 313{-# INLINE unfolded #-} 314 315-- | @x '^.' 'iterated' f@ returns an infinite 'Fold1' of repeated applications of @f@ to @x@. 316-- 317-- @ 318-- 'toListOf' ('iterated' f) a ≡ 'iterate' f a 319-- @ 320-- 321-- @ 322-- 'iterated' :: (a -> a) -> 'Fold1' a a 323-- @ 324iterated :: Apply f => (a -> a) -> LensLike' f a a 325iterated f g a0 = go a0 where 326 go a = g a .> go (f a) 327{-# INLINE iterated #-} 328 329-- | Obtain a 'Fold' that can be composed with to filter another 'Lens', 'Iso', 'Getter', 'Fold' (or 'Traversal'). 330-- 331-- Note: This is /not/ a legal 'Traversal', unless you are very careful not to invalidate the predicate on the target. 332-- 333-- Note: This is also /not/ a legal 'Prism', unless you are very careful not to inject a value that fails the predicate. 334-- 335-- As a counter example, consider that given @evens = 'filtered' 'even'@ the second 'Traversal' law is violated: 336-- 337-- @ 338-- 'Control.Lens.Setter.over' evens 'succ' '.' 'Control.Lens.Setter.over' evens 'succ' '/=' 'Control.Lens.Setter.over' evens ('succ' '.' 'succ') 339-- @ 340-- 341-- So, in order for this to qualify as a legal 'Traversal' you can only use it for actions that preserve the result of the predicate! 342-- 343-- >>> [1..10]^..folded.filtered even 344-- [2,4,6,8,10] 345-- 346-- This will preserve an index if it is present. 347filtered :: (Choice p, Applicative f) => (a -> Bool) -> Optic' p f a a 348filtered p = dimap (\x -> if p x then Right x else Left x) (either pure id) . right' 349{-# INLINE filtered #-} 350 351-- | Obtain a potentially empty 'IndexedTraversal' by taking the first element from another, 352-- potentially empty `Fold` and using it as an index. 353-- 354-- The resulting optic can be composed with to filter another 'Lens', 'Iso', 'Getter', 'Fold' (or 'Traversal'). 355-- 356-- >>> [(Just 2, 3), (Nothing, 4)] & mapped . filteredBy (_1 . _Just) <. _2 %@~ (*) :: [(Maybe Int, Int)] 357-- [(Just 2,6),(Nothing,4)] 358-- 359-- @ 360-- 'filteredBy' :: 'Fold' a i -> 'IndexedTraversal'' i a a 361-- @ 362-- 363-- Note: As with 'filtered', this is /not/ a legal 'IndexedTraversal', unless you are very careful not to invalidate the predicate on the target! 364filteredBy :: (Indexable i p, Applicative f) => Getting (First i) a i -> p a (f a) -> a -> f a 365filteredBy p f val = case val ^? p of 366 Nothing -> pure val 367 Just witness -> indexed f witness val 368 369-- | Obtain a 'Fold' by taking elements from another 'Fold', 'Lens', 'Iso', 'Getter' or 'Traversal' while a predicate holds. 370-- 371-- @ 372-- 'takeWhile' p ≡ 'toListOf' ('takingWhile' p 'folded') 373-- @ 374-- 375-- >>> timingOut $ toListOf (takingWhile (<=3) folded) [1..] 376-- [1,2,3] 377-- 378-- @ 379-- 'takingWhile' :: (a -> 'Bool') -> 'Fold' s a -> 'Fold' s a 380-- 'takingWhile' :: (a -> 'Bool') -> 'Getter' s a -> 'Fold' s a 381-- 'takingWhile' :: (a -> 'Bool') -> 'Traversal'' s a -> 'Fold' s a -- * See note below 382-- 'takingWhile' :: (a -> 'Bool') -> 'Lens'' s a -> 'Fold' s a -- * See note below 383-- 'takingWhile' :: (a -> 'Bool') -> 'Prism'' s a -> 'Fold' s a -- * See note below 384-- 'takingWhile' :: (a -> 'Bool') -> 'Iso'' s a -> 'Fold' s a -- * See note below 385-- 'takingWhile' :: (a -> 'Bool') -> 'IndexedTraversal'' i s a -> 'IndexedFold' i s a -- * See note below 386-- 'takingWhile' :: (a -> 'Bool') -> 'IndexedLens'' i s a -> 'IndexedFold' i s a -- * See note below 387-- 'takingWhile' :: (a -> 'Bool') -> 'IndexedFold' i s a -> 'IndexedFold' i s a 388-- 'takingWhile' :: (a -> 'Bool') -> 'IndexedGetter' i s a -> 'IndexedFold' i s a 389-- @ 390-- 391-- /Note:/ When applied to a 'Traversal', 'takingWhile' yields something that can be used as if it were a 'Traversal', but 392-- which is not a 'Traversal' per the laws, unless you are careful to ensure that you do not invalidate the predicate when 393-- writing back through it. 394takingWhile :: (Conjoined p, Applicative f) => (a -> Bool) -> Over p (TakingWhile p f a a) s t a a -> Over p f s t a a 395takingWhile p l pafb = fmap runMagma . traverse (cosieve pafb) . runTakingWhile . l flag where 396 flag = cotabulate $ \wa -> let a = extract wa; r = p a in TakingWhile r a $ \pr -> 397 if pr && r then Magma () wa else MagmaPure a 398{-# INLINE takingWhile #-} 399 400-- | Obtain a 'Fold' by dropping elements from another 'Fold', 'Lens', 'Iso', 'Getter' or 'Traversal' while a predicate holds. 401-- 402-- @ 403-- 'dropWhile' p ≡ 'toListOf' ('droppingWhile' p 'folded') 404-- @ 405-- 406-- >>> toListOf (droppingWhile (<=3) folded) [1..6] 407-- [4,5,6] 408-- 409-- >>> toListOf (droppingWhile (<=3) folded) [1,6,1] 410-- [6,1] 411-- 412-- @ 413-- 'droppingWhile' :: (a -> 'Bool') -> 'Fold' s a -> 'Fold' s a 414-- 'droppingWhile' :: (a -> 'Bool') -> 'Getter' s a -> 'Fold' s a 415-- 'droppingWhile' :: (a -> 'Bool') -> 'Traversal'' s a -> 'Fold' s a -- see notes 416-- 'droppingWhile' :: (a -> 'Bool') -> 'Lens'' s a -> 'Fold' s a -- see notes 417-- 'droppingWhile' :: (a -> 'Bool') -> 'Prism'' s a -> 'Fold' s a -- see notes 418-- 'droppingWhile' :: (a -> 'Bool') -> 'Iso'' s a -> 'Fold' s a -- see notes 419-- @ 420-- 421-- @ 422-- 'droppingWhile' :: (a -> 'Bool') -> 'IndexPreservingTraversal'' s a -> 'IndexPreservingFold' s a -- see notes 423-- 'droppingWhile' :: (a -> 'Bool') -> 'IndexPreservingLens'' s a -> 'IndexPreservingFold' s a -- see notes 424-- 'droppingWhile' :: (a -> 'Bool') -> 'IndexPreservingGetter' s a -> 'IndexPreservingFold' s a 425-- 'droppingWhile' :: (a -> 'Bool') -> 'IndexPreservingFold' s a -> 'IndexPreservingFold' s a 426-- @ 427-- 428-- @ 429-- 'droppingWhile' :: (a -> 'Bool') -> 'IndexedTraversal'' i s a -> 'IndexedFold' i s a -- see notes 430-- 'droppingWhile' :: (a -> 'Bool') -> 'IndexedLens'' i s a -> 'IndexedFold' i s a -- see notes 431-- 'droppingWhile' :: (a -> 'Bool') -> 'IndexedGetter' i s a -> 'IndexedFold' i s a 432-- 'droppingWhile' :: (a -> 'Bool') -> 'IndexedFold' i s a -> 'IndexedFold' i s a 433-- @ 434-- 435-- Note: Many uses of this combinator will yield something that meets the types, but not the laws of a valid 436-- 'Traversal' or 'IndexedTraversal'. The 'Traversal' and 'IndexedTraversal' laws are only satisfied if the 437-- new values you assign to the first target also does not pass the predicate! Otherwise subsequent traversals 438-- will visit fewer elements and 'Traversal' fusion is not sound. 439-- 440-- So for any traversal @t@ and predicate @p@, @`droppingWhile` p t@ may not be lawful, but 441-- @(`Control.Lens.Traversal.dropping` 1 . `droppingWhile` p) t@ is. For example: 442-- 443-- >>> let l :: Traversal' [Int] Int; l = droppingWhile (<= 1) traverse 444-- >>> let l' :: Traversal' [Int] Int; l' = dropping 1 l 445-- 446-- @l@ is not a lawful setter because @`Control.Lens.Setter.over` l f . 447-- `Control.Lens.Setter.over` l g ≢ `Control.Lens.Setter.over` l (f . g)@: 448-- 449-- >>> [1,2,3] & l .~ 0 & l .~ 4 450-- [1,0,0] 451-- >>> [1,2,3] & l .~ 4 452-- [1,4,4] 453-- 454-- @l'@ on the other hand behaves lawfully: 455-- 456-- >>> [1,2,3] & l' .~ 0 & l' .~ 4 457-- [1,2,4] 458-- >>> [1,2,3] & l' .~ 4 459-- [1,2,4] 460droppingWhile :: (Conjoined p, Profunctor q, Applicative f) 461 => (a -> Bool) 462 -> Optical p q (Compose (State Bool) f) s t a a 463 -> Optical p q f s t a a 464droppingWhile p l f = (flip evalState True .# getCompose) `rmap` l g where 465 g = cotabulate $ \wa -> Compose $ state $ \b -> let 466 a = extract wa 467 b' = b && p a 468 in (if b' then pure a else cosieve f wa, b') 469{-# INLINE droppingWhile #-} 470 471-- | A 'Fold' over the individual 'words' of a 'String'. 472-- 473-- @ 474-- 'worded' :: 'Fold' 'String' 'String' 475-- 'worded' :: 'Traversal'' 'String' 'String' 476-- @ 477-- 478-- @ 479-- 'worded' :: 'IndexedFold' 'Int' 'String' 'String' 480-- 'worded' :: 'IndexedTraversal'' 'Int' 'String' 'String' 481-- @ 482-- 483-- Note: This function type-checks as a 'Traversal' but it doesn't satisfy the laws. It's only valid to use it 484-- when you don't insert any whitespace characters while traversing, and if your original 'String' contains only 485-- isolated space characters (and no other characters that count as space, such as non-breaking spaces). 486worded :: Applicative f => IndexedLensLike' Int f String String 487worded f = fmap unwords . conjoined traverse (indexing traverse) f . words 488{-# INLINE worded #-} 489 490-- | A 'Fold' over the individual 'lines' of a 'String'. 491-- 492-- @ 493-- 'lined' :: 'Fold' 'String' 'String' 494-- 'lined' :: 'Traversal'' 'String' 'String' 495-- @ 496-- 497-- @ 498-- 'lined' :: 'IndexedFold' 'Int' 'String' 'String' 499-- 'lined' :: 'IndexedTraversal'' 'Int' 'String' 'String' 500-- @ 501-- 502-- Note: This function type-checks as a 'Traversal' but it doesn't satisfy the laws. It's only valid to use it 503-- when you don't insert any newline characters while traversing, and if your original 'String' contains only 504-- isolated newline characters. 505lined :: Applicative f => IndexedLensLike' Int f String String 506lined f = fmap (intercalate "\n") . conjoined traverse (indexing traverse) f . lines 507{-# INLINE lined #-} 508 509-------------------------- 510-- Fold/Getter combinators 511-------------------------- 512 513-- | Map each part of a structure viewed through a 'Lens', 'Getter', 514-- 'Fold' or 'Traversal' to a monoid and combine the results. 515-- 516-- >>> foldMapOf (folded . both . _Just) Sum [(Just 21, Just 21)] 517-- Sum {getSum = 42} 518-- 519-- @ 520-- 'Data.Foldable.foldMap' = 'foldMapOf' 'folded' 521-- @ 522-- 523-- @ 524-- 'foldMapOf' ≡ 'views' 525-- 'ifoldMapOf' l = 'foldMapOf' l '.' 'Indexed' 526-- @ 527-- 528-- @ 529-- 'foldMapOf' :: 'Getter' s a -> (a -> r) -> s -> r 530-- 'foldMapOf' :: 'Monoid' r => 'Fold' s a -> (a -> r) -> s -> r 531-- 'foldMapOf' :: 'Semigroup' r => 'Fold1' s a -> (a -> r) -> s -> r 532-- 'foldMapOf' :: 'Lens'' s a -> (a -> r) -> s -> r 533-- 'foldMapOf' :: 'Iso'' s a -> (a -> r) -> s -> r 534-- 'foldMapOf' :: 'Monoid' r => 'Traversal'' s a -> (a -> r) -> s -> r 535-- 'foldMapOf' :: 'Semigroup' r => 'Traversal1'' s a -> (a -> r) -> s -> r 536-- 'foldMapOf' :: 'Monoid' r => 'Prism'' s a -> (a -> r) -> s -> r 537-- @ 538-- 539-- @ 540-- 'foldMapOf' :: 'Getting' r s a -> (a -> r) -> s -> r 541-- @ 542foldMapOf :: Getting r s a -> (a -> r) -> s -> r 543foldMapOf l f = getConst #. l (Const #. f) 544{-# INLINE foldMapOf #-} 545 546-- | Combine the elements of a structure viewed through a 'Lens', 'Getter', 547-- 'Fold' or 'Traversal' using a monoid. 548-- 549-- >>> foldOf (folded.folded) [[Sum 1,Sum 4],[Sum 8, Sum 8],[Sum 21]] 550-- Sum {getSum = 42} 551-- 552-- @ 553-- 'Data.Foldable.fold' = 'foldOf' 'folded' 554-- @ 555-- 556-- @ 557-- 'foldOf' ≡ 'view' 558-- @ 559-- 560-- @ 561-- 'foldOf' :: 'Getter' s m -> s -> m 562-- 'foldOf' :: 'Monoid' m => 'Fold' s m -> s -> m 563-- 'foldOf' :: 'Lens'' s m -> s -> m 564-- 'foldOf' :: 'Iso'' s m -> s -> m 565-- 'foldOf' :: 'Monoid' m => 'Traversal'' s m -> s -> m 566-- 'foldOf' :: 'Monoid' m => 'Prism'' s m -> s -> m 567-- @ 568foldOf :: Getting a s a -> s -> a 569foldOf l = getConst #. l Const 570{-# INLINE foldOf #-} 571 572-- | Right-associative fold of parts of a structure that are viewed through a 'Lens', 'Getter', 'Fold' or 'Traversal'. 573-- 574-- @ 575-- 'Data.Foldable.foldr' ≡ 'foldrOf' 'folded' 576-- @ 577-- 578-- @ 579-- 'foldrOf' :: 'Getter' s a -> (a -> r -> r) -> r -> s -> r 580-- 'foldrOf' :: 'Fold' s a -> (a -> r -> r) -> r -> s -> r 581-- 'foldrOf' :: 'Lens'' s a -> (a -> r -> r) -> r -> s -> r 582-- 'foldrOf' :: 'Iso'' s a -> (a -> r -> r) -> r -> s -> r 583-- 'foldrOf' :: 'Traversal'' s a -> (a -> r -> r) -> r -> s -> r 584-- 'foldrOf' :: 'Prism'' s a -> (a -> r -> r) -> r -> s -> r 585-- @ 586-- 587-- @ 588-- 'ifoldrOf' l ≡ 'foldrOf' l '.' 'Indexed' 589-- @ 590-- 591-- @ 592-- 'foldrOf' :: 'Getting' ('Endo' r) s a -> (a -> r -> r) -> r -> s -> r 593-- @ 594foldrOf :: Getting (Endo r) s a -> (a -> r -> r) -> r -> s -> r 595foldrOf l f z = flip appEndo z . foldMapOf l (Endo #. f) 596{-# INLINE foldrOf #-} 597 598-- | Left-associative fold of the parts of a structure that are viewed through a 'Lens', 'Getter', 'Fold' or 'Traversal'. 599-- 600-- @ 601-- 'Data.Foldable.foldl' ≡ 'foldlOf' 'folded' 602-- @ 603-- 604-- @ 605-- 'foldlOf' :: 'Getter' s a -> (r -> a -> r) -> r -> s -> r 606-- 'foldlOf' :: 'Fold' s a -> (r -> a -> r) -> r -> s -> r 607-- 'foldlOf' :: 'Lens'' s a -> (r -> a -> r) -> r -> s -> r 608-- 'foldlOf' :: 'Iso'' s a -> (r -> a -> r) -> r -> s -> r 609-- 'foldlOf' :: 'Traversal'' s a -> (r -> a -> r) -> r -> s -> r 610-- 'foldlOf' :: 'Prism'' s a -> (r -> a -> r) -> r -> s -> r 611-- @ 612foldlOf :: Getting (Dual (Endo r)) s a -> (r -> a -> r) -> r -> s -> r 613foldlOf l f z = (flip appEndo z .# getDual) `rmap` foldMapOf l (Dual #. Endo #. flip f) 614{-# INLINE foldlOf #-} 615 616-- | Extract a list of the targets of a 'Fold'. See also ('^..'). 617-- 618-- @ 619-- 'Data.Foldable.toList' ≡ 'toListOf' 'folded' 620-- ('^..') ≡ 'flip' 'toListOf' 621-- @ 622 623-- >>> toListOf both ("hello","world") 624-- ["hello","world"] 625-- 626-- @ 627-- 'toListOf' :: 'Getter' s a -> s -> [a] 628-- 'toListOf' :: 'Fold' s a -> s -> [a] 629-- 'toListOf' :: 'Lens'' s a -> s -> [a] 630-- 'toListOf' :: 'Iso'' s a -> s -> [a] 631-- 'toListOf' :: 'Traversal'' s a -> s -> [a] 632-- 'toListOf' :: 'Prism'' s a -> s -> [a] 633-- @ 634toListOf :: Getting (Endo [a]) s a -> s -> [a] 635toListOf l = foldrOf l (:) [] 636{-# INLINE toListOf #-} 637 638-- | Extract a 'NonEmpty' of the targets of 'Fold1'. 639-- 640-- >>> toNonEmptyOf both1 ("hello", "world") 641-- "hello" :| ["world"] 642-- 643-- @ 644-- 'toNonEmptyOf' :: 'Getter' s a -> s -> NonEmpty a 645-- 'toNonEmptyOf' :: 'Fold1' s a -> s -> NonEmpty a 646-- 'toNonEmptyOf' :: 'Lens'' s a -> s -> NonEmpty a 647-- 'toNonEmptyOf' :: 'Iso'' s a -> s -> NonEmpty a 648-- 'toNonEmptyOf' :: 'Traversal1'' s a -> s -> NonEmpty a 649-- 'toNonEmptyOf' :: 'Prism'' s a -> s -> NonEmpty a 650-- @ 651toNonEmptyOf :: Getting (NonEmptyDList a) s a -> s -> NonEmpty a 652toNonEmptyOf l = flip getNonEmptyDList [] . foldMapOf l (NonEmptyDList #. (:|)) 653 654-- | A convenient infix (flipped) version of 'toListOf'. 655-- 656-- >>> [[1,2],[3]]^..id 657-- [[[1,2],[3]]] 658-- >>> [[1,2],[3]]^..traverse 659-- [[1,2],[3]] 660-- >>> [[1,2],[3]]^..traverse.traverse 661-- [1,2,3] 662-- 663-- >>> (1,2)^..both 664-- [1,2] 665-- 666-- @ 667-- 'Data.Foldable.toList' xs ≡ xs '^..' 'folded' 668-- ('^..') ≡ 'flip' 'toListOf' 669-- @ 670-- 671-- @ 672-- ('^..') :: s -> 'Getter' s a -> [a] 673-- ('^..') :: s -> 'Fold' s a -> [a] 674-- ('^..') :: s -> 'Lens'' s a -> [a] 675-- ('^..') :: s -> 'Iso'' s a -> [a] 676-- ('^..') :: s -> 'Traversal'' s a -> [a] 677-- ('^..') :: s -> 'Prism'' s a -> [a] 678-- @ 679(^..) :: s -> Getting (Endo [a]) s a -> [a] 680s ^.. l = toListOf l s 681{-# INLINE (^..) #-} 682 683-- | Returns 'True' if every target of a 'Fold' is 'True'. 684-- 685-- >>> andOf both (True,False) 686-- False 687-- >>> andOf both (True,True) 688-- True 689-- 690-- @ 691-- 'Data.Foldable.and' ≡ 'andOf' 'folded' 692-- @ 693-- 694-- @ 695-- 'andOf' :: 'Getter' s 'Bool' -> s -> 'Bool' 696-- 'andOf' :: 'Fold' s 'Bool' -> s -> 'Bool' 697-- 'andOf' :: 'Lens'' s 'Bool' -> s -> 'Bool' 698-- 'andOf' :: 'Iso'' s 'Bool' -> s -> 'Bool' 699-- 'andOf' :: 'Traversal'' s 'Bool' -> s -> 'Bool' 700-- 'andOf' :: 'Prism'' s 'Bool' -> s -> 'Bool' 701-- @ 702andOf :: Getting All s Bool -> s -> Bool 703andOf l = getAll #. foldMapOf l All 704{-# INLINE andOf #-} 705 706-- | Returns 'True' if any target of a 'Fold' is 'True'. 707-- 708-- >>> orOf both (True,False) 709-- True 710-- >>> orOf both (False,False) 711-- False 712-- 713-- @ 714-- 'Data.Foldable.or' ≡ 'orOf' 'folded' 715-- @ 716-- 717-- @ 718-- 'orOf' :: 'Getter' s 'Bool' -> s -> 'Bool' 719-- 'orOf' :: 'Fold' s 'Bool' -> s -> 'Bool' 720-- 'orOf' :: 'Lens'' s 'Bool' -> s -> 'Bool' 721-- 'orOf' :: 'Iso'' s 'Bool' -> s -> 'Bool' 722-- 'orOf' :: 'Traversal'' s 'Bool' -> s -> 'Bool' 723-- 'orOf' :: 'Prism'' s 'Bool' -> s -> 'Bool' 724-- @ 725orOf :: Getting Any s Bool -> s -> Bool 726orOf l = getAny #. foldMapOf l Any 727{-# INLINE orOf #-} 728 729-- | Returns 'True' if any target of a 'Fold' satisfies a predicate. 730-- 731-- >>> anyOf both (=='x') ('x','y') 732-- True 733-- >>> import Data.Data.Lens 734-- >>> anyOf biplate (== "world") (((),2::Int),"hello",("world",11::Int)) 735-- True 736-- 737-- @ 738-- 'Data.Foldable.any' ≡ 'anyOf' 'folded' 739-- @ 740-- 741-- @ 742-- 'ianyOf' l ≡ 'anyOf' l '.' 'Indexed' 743-- @ 744-- 745-- @ 746-- 'anyOf' :: 'Getter' s a -> (a -> 'Bool') -> s -> 'Bool' 747-- 'anyOf' :: 'Fold' s a -> (a -> 'Bool') -> s -> 'Bool' 748-- 'anyOf' :: 'Lens'' s a -> (a -> 'Bool') -> s -> 'Bool' 749-- 'anyOf' :: 'Iso'' s a -> (a -> 'Bool') -> s -> 'Bool' 750-- 'anyOf' :: 'Traversal'' s a -> (a -> 'Bool') -> s -> 'Bool' 751-- 'anyOf' :: 'Prism'' s a -> (a -> 'Bool') -> s -> 'Bool' 752-- @ 753anyOf :: Getting Any s a -> (a -> Bool) -> s -> Bool 754anyOf l f = getAny #. foldMapOf l (Any #. f) 755{-# INLINE anyOf #-} 756 757-- | Returns 'True' if every target of a 'Fold' satisfies a predicate. 758-- 759-- >>> allOf both (>=3) (4,5) 760-- True 761-- >>> allOf folded (>=2) [1..10] 762-- False 763-- 764-- @ 765-- 'Data.Foldable.all' ≡ 'allOf' 'folded' 766-- @ 767-- 768-- @ 769-- 'iallOf' l = 'allOf' l '.' 'Indexed' 770-- @ 771-- 772-- @ 773-- 'allOf' :: 'Getter' s a -> (a -> 'Bool') -> s -> 'Bool' 774-- 'allOf' :: 'Fold' s a -> (a -> 'Bool') -> s -> 'Bool' 775-- 'allOf' :: 'Lens'' s a -> (a -> 'Bool') -> s -> 'Bool' 776-- 'allOf' :: 'Iso'' s a -> (a -> 'Bool') -> s -> 'Bool' 777-- 'allOf' :: 'Traversal'' s a -> (a -> 'Bool') -> s -> 'Bool' 778-- 'allOf' :: 'Prism'' s a -> (a -> 'Bool') -> s -> 'Bool' 779-- @ 780allOf :: Getting All s a -> (a -> Bool) -> s -> Bool 781allOf l f = getAll #. foldMapOf l (All #. f) 782{-# INLINE allOf #-} 783 784-- | Returns 'True' only if no targets of a 'Fold' satisfy a predicate. 785-- 786-- >>> noneOf each (is _Nothing) (Just 3, Just 4, Just 5) 787-- True 788-- >>> noneOf (folded.folded) (<10) [[13,99,20],[3,71,42]] 789-- False 790-- 791-- @ 792-- 'inoneOf' l = 'noneOf' l '.' 'Indexed' 793-- @ 794-- 795-- @ 796-- 'noneOf' :: 'Getter' s a -> (a -> 'Bool') -> s -> 'Bool' 797-- 'noneOf' :: 'Fold' s a -> (a -> 'Bool') -> s -> 'Bool' 798-- 'noneOf' :: 'Lens'' s a -> (a -> 'Bool') -> s -> 'Bool' 799-- 'noneOf' :: 'Iso'' s a -> (a -> 'Bool') -> s -> 'Bool' 800-- 'noneOf' :: 'Traversal'' s a -> (a -> 'Bool') -> s -> 'Bool' 801-- 'noneOf' :: 'Prism'' s a -> (a -> 'Bool') -> s -> 'Bool' 802-- @ 803noneOf :: Getting Any s a -> (a -> Bool) -> s -> Bool 804noneOf l f = not . anyOf l f 805{-# INLINE noneOf #-} 806 807-- | Calculate the 'Product' of every number targeted by a 'Fold'. 808-- 809-- >>> productOf both (4,5) 810-- 20 811-- >>> productOf folded [1,2,3,4,5] 812-- 120 813-- 814-- @ 815-- 'Data.Foldable.product' ≡ 'productOf' 'folded' 816-- @ 817-- 818-- This operation may be more strict than you would expect. If you 819-- want a lazier version use @'ala' 'Product' '.' 'foldMapOf'@ 820-- 821-- @ 822-- 'productOf' :: 'Num' a => 'Getter' s a -> s -> a 823-- 'productOf' :: 'Num' a => 'Fold' s a -> s -> a 824-- 'productOf' :: 'Num' a => 'Lens'' s a -> s -> a 825-- 'productOf' :: 'Num' a => 'Iso'' s a -> s -> a 826-- 'productOf' :: 'Num' a => 'Traversal'' s a -> s -> a 827-- 'productOf' :: 'Num' a => 'Prism'' s a -> s -> a 828-- @ 829productOf :: Num a => Getting (Endo (Endo a)) s a -> s -> a 830productOf l = foldlOf' l (*) 1 831{-# INLINE productOf #-} 832 833-- | Calculate the 'Sum' of every number targeted by a 'Fold'. 834-- 835-- >>> sumOf both (5,6) 836-- 11 837-- >>> sumOf folded [1,2,3,4] 838-- 10 839-- >>> sumOf (folded.both) [(1,2),(3,4)] 840-- 10 841-- >>> import Data.Data.Lens 842-- >>> sumOf biplate [(1::Int,[]),(2,[(3::Int,4::Int)])] :: Int 843-- 10 844-- 845-- @ 846-- 'Data.Foldable.sum' ≡ 'sumOf' 'folded' 847-- @ 848-- 849-- This operation may be more strict than you would expect. If you 850-- want a lazier version use @'ala' 'Sum' '.' 'foldMapOf'@ 851-- 852-- @ 853-- 'sumOf' '_1' :: 'Num' a => (a, b) -> a 854-- 'sumOf' ('folded' '.' 'Control.Lens.Tuple._1') :: ('Foldable' f, 'Num' a) => f (a, b) -> a 855-- @ 856-- 857-- @ 858-- 'sumOf' :: 'Num' a => 'Getter' s a -> s -> a 859-- 'sumOf' :: 'Num' a => 'Fold' s a -> s -> a 860-- 'sumOf' :: 'Num' a => 'Lens'' s a -> s -> a 861-- 'sumOf' :: 'Num' a => 'Iso'' s a -> s -> a 862-- 'sumOf' :: 'Num' a => 'Traversal'' s a -> s -> a 863-- 'sumOf' :: 'Num' a => 'Prism'' s a -> s -> a 864-- @ 865sumOf :: Num a => Getting (Endo (Endo a)) s a -> s -> a 866sumOf l = foldlOf' l (+) 0 867{-# INLINE sumOf #-} 868 869-- | Traverse over all of the targets of a 'Fold' (or 'Getter'), computing an 'Applicative' (or 'Functor')-based answer, 870-- but unlike 'Control.Lens.Traversal.traverseOf' do not construct a new structure. 'traverseOf_' generalizes 871-- 'Data.Foldable.traverse_' to work over any 'Fold'. 872-- 873-- When passed a 'Getter', 'traverseOf_' can work over any 'Functor', but when passed a 'Fold', 'traverseOf_' requires 874-- an 'Applicative'. 875-- 876-- >>> traverseOf_ both putStrLn ("hello","world") 877-- hello 878-- world 879-- 880-- @ 881-- 'Data.Foldable.traverse_' ≡ 'traverseOf_' 'folded' 882-- @ 883-- 884-- @ 885-- 'traverseOf_' '_2' :: 'Functor' f => (c -> f r) -> (d, c) -> f () 886-- 'traverseOf_' 'Control.Lens.Prism._Left' :: 'Applicative' f => (a -> f b) -> 'Either' a c -> f () 887-- @ 888-- 889-- @ 890-- 'itraverseOf_' l ≡ 'traverseOf_' l '.' 'Indexed' 891-- @ 892-- 893-- The rather specific signature of 'traverseOf_' allows it to be used as if the signature was any of: 894-- 895-- @ 896-- 'traverseOf_' :: 'Functor' f => 'Getter' s a -> (a -> f r) -> s -> f () 897-- 'traverseOf_' :: 'Applicative' f => 'Fold' s a -> (a -> f r) -> s -> f () 898-- 'traverseOf_' :: 'Functor' f => 'Lens'' s a -> (a -> f r) -> s -> f () 899-- 'traverseOf_' :: 'Functor' f => 'Iso'' s a -> (a -> f r) -> s -> f () 900-- 'traverseOf_' :: 'Applicative' f => 'Traversal'' s a -> (a -> f r) -> s -> f () 901-- 'traverseOf_' :: 'Applicative' f => 'Prism'' s a -> (a -> f r) -> s -> f () 902-- @ 903traverseOf_ :: Functor f => Getting (Traversed r f) s a -> (a -> f r) -> s -> f () 904traverseOf_ l f = void . getTraversed #. foldMapOf l (Traversed #. f) 905{-# INLINE traverseOf_ #-} 906 907-- | Traverse over all of the targets of a 'Fold' (or 'Getter'), computing an 'Applicative' (or 'Functor')-based answer, 908-- but unlike 'Control.Lens.Traversal.forOf' do not construct a new structure. 'forOf_' generalizes 909-- 'Data.Foldable.for_' to work over any 'Fold'. 910-- 911-- When passed a 'Getter', 'forOf_' can work over any 'Functor', but when passed a 'Fold', 'forOf_' requires 912-- an 'Applicative'. 913-- 914-- @ 915-- 'for_' ≡ 'forOf_' 'folded' 916-- @ 917-- 918-- >>> forOf_ both ("hello","world") putStrLn 919-- hello 920-- world 921-- 922-- The rather specific signature of 'forOf_' allows it to be used as if the signature was any of: 923-- 924-- @ 925-- 'iforOf_' l s ≡ 'forOf_' l s '.' 'Indexed' 926-- @ 927-- 928-- @ 929-- 'forOf_' :: 'Functor' f => 'Getter' s a -> s -> (a -> f r) -> f () 930-- 'forOf_' :: 'Applicative' f => 'Fold' s a -> s -> (a -> f r) -> f () 931-- 'forOf_' :: 'Functor' f => 'Lens'' s a -> s -> (a -> f r) -> f () 932-- 'forOf_' :: 'Functor' f => 'Iso'' s a -> s -> (a -> f r) -> f () 933-- 'forOf_' :: 'Applicative' f => 'Traversal'' s a -> s -> (a -> f r) -> f () 934-- 'forOf_' :: 'Applicative' f => 'Prism'' s a -> s -> (a -> f r) -> f () 935-- @ 936forOf_ :: Functor f => Getting (Traversed r f) s a -> s -> (a -> f r) -> f () 937forOf_ = flip . traverseOf_ 938{-# INLINE forOf_ #-} 939 940-- | Evaluate each action in observed by a 'Fold' on a structure from left to right, ignoring the results. 941-- 942-- @ 943-- 'sequenceA_' ≡ 'sequenceAOf_' 'folded' 944-- @ 945-- 946-- >>> sequenceAOf_ both (putStrLn "hello",putStrLn "world") 947-- hello 948-- world 949-- 950-- @ 951-- 'sequenceAOf_' :: 'Functor' f => 'Getter' s (f a) -> s -> f () 952-- 'sequenceAOf_' :: 'Applicative' f => 'Fold' s (f a) -> s -> f () 953-- 'sequenceAOf_' :: 'Functor' f => 'Lens'' s (f a) -> s -> f () 954-- 'sequenceAOf_' :: 'Functor' f => 'Iso'' s (f a) -> s -> f () 955-- 'sequenceAOf_' :: 'Applicative' f => 'Traversal'' s (f a) -> s -> f () 956-- 'sequenceAOf_' :: 'Applicative' f => 'Prism'' s (f a) -> s -> f () 957-- @ 958sequenceAOf_ :: Functor f => Getting (Traversed a f) s (f a) -> s -> f () 959sequenceAOf_ l = void . getTraversed #. foldMapOf l Traversed 960{-# INLINE sequenceAOf_ #-} 961 962-- | Traverse over all of the targets of a 'Fold1', computing an 'Apply' based answer. 963-- 964-- As long as you have 'Applicative' or 'Functor' effect you are better using 'traverseOf_'. 965-- The 'traverse1Of_' is useful only when you have genuine 'Apply' effect. 966-- 967-- >>> traverse1Of_ both1 (\ks -> Map.fromList [ (k, ()) | k <- ks ]) ("abc", "bcd") 968-- fromList [('b',()),('c',())] 969-- 970-- @ 971-- 'traverse1Of_' :: 'Apply' f => 'Fold1' s a -> (a -> f r) -> s -> f () 972-- @ 973-- 974-- @since 4.16 975traverse1Of_ :: Functor f => Getting (TraversedF r f) s a -> (a -> f r) -> s -> f () 976traverse1Of_ l f = void . getTraversedF #. foldMapOf l (TraversedF #. f) 977{-# INLINE traverse1Of_ #-} 978 979-- | See 'forOf_' and 'traverse1Of_'. 980-- 981-- >>> for1Of_ both1 ("abc", "bcd") (\ks -> Map.fromList [ (k, ()) | k <- ks ]) 982-- fromList [('b',()),('c',())] 983-- 984-- @ 985-- 'for1Of_' :: 'Apply' f => 'Fold1' s a -> s -> (a -> f r) -> f () 986-- @ 987-- 988-- @since 4.16 989for1Of_ :: Functor f => Getting (TraversedF r f) s a -> s -> (a -> f r) -> f () 990for1Of_ = flip . traverse1Of_ 991{-# INLINE for1Of_ #-} 992 993-- | See 'sequenceAOf_' and 'traverse1Of_'. 994-- 995-- @ 996-- 'sequence1Of_' :: 'Apply' f => 'Fold1' s (f a) -> s -> f () 997-- @ 998-- 999-- @since 4.16 1000sequence1Of_ :: Functor f => Getting (TraversedF a f) s (f a) -> s -> f () 1001sequence1Of_ l = void . getTraversedF #. foldMapOf l TraversedF 1002{-# INLINE sequence1Of_ #-} 1003 1004-- | Map each target of a 'Fold' on a structure to a monadic action, evaluate these actions from left to right, and ignore the results. 1005-- 1006-- >>> mapMOf_ both putStrLn ("hello","world") 1007-- hello 1008-- world 1009-- 1010-- @ 1011-- 'Data.Foldable.mapM_' ≡ 'mapMOf_' 'folded' 1012-- @ 1013-- 1014-- @ 1015-- 'mapMOf_' :: 'Monad' m => 'Getter' s a -> (a -> m r) -> s -> m () 1016-- 'mapMOf_' :: 'Monad' m => 'Fold' s a -> (a -> m r) -> s -> m () 1017-- 'mapMOf_' :: 'Monad' m => 'Lens'' s a -> (a -> m r) -> s -> m () 1018-- 'mapMOf_' :: 'Monad' m => 'Iso'' s a -> (a -> m r) -> s -> m () 1019-- 'mapMOf_' :: 'Monad' m => 'Traversal'' s a -> (a -> m r) -> s -> m () 1020-- 'mapMOf_' :: 'Monad' m => 'Prism'' s a -> (a -> m r) -> s -> m () 1021-- @ 1022mapMOf_ :: Monad m => Getting (Sequenced r m) s a -> (a -> m r) -> s -> m () 1023mapMOf_ l f = liftM skip . getSequenced #. foldMapOf l (Sequenced #. f) 1024{-# INLINE mapMOf_ #-} 1025 1026-- | 'forMOf_' is 'mapMOf_' with two of its arguments flipped. 1027-- 1028-- >>> forMOf_ both ("hello","world") putStrLn 1029-- hello 1030-- world 1031-- 1032-- @ 1033-- 'Data.Foldable.forM_' ≡ 'forMOf_' 'folded' 1034-- @ 1035-- 1036-- @ 1037-- 'forMOf_' :: 'Monad' m => 'Getter' s a -> s -> (a -> m r) -> m () 1038-- 'forMOf_' :: 'Monad' m => 'Fold' s a -> s -> (a -> m r) -> m () 1039-- 'forMOf_' :: 'Monad' m => 'Lens'' s a -> s -> (a -> m r) -> m () 1040-- 'forMOf_' :: 'Monad' m => 'Iso'' s a -> s -> (a -> m r) -> m () 1041-- 'forMOf_' :: 'Monad' m => 'Traversal'' s a -> s -> (a -> m r) -> m () 1042-- 'forMOf_' :: 'Monad' m => 'Prism'' s a -> s -> (a -> m r) -> m () 1043-- @ 1044forMOf_ :: Monad m => Getting (Sequenced r m) s a -> s -> (a -> m r) -> m () 1045forMOf_ = flip . mapMOf_ 1046{-# INLINE forMOf_ #-} 1047 1048-- | Evaluate each monadic action referenced by a 'Fold' on the structure from left to right, and ignore the results. 1049-- 1050-- >>> sequenceOf_ both (putStrLn "hello",putStrLn "world") 1051-- hello 1052-- world 1053-- 1054-- @ 1055-- 'Data.Foldable.sequence_' ≡ 'sequenceOf_' 'folded' 1056-- @ 1057-- 1058-- @ 1059-- 'sequenceOf_' :: 'Monad' m => 'Getter' s (m a) -> s -> m () 1060-- 'sequenceOf_' :: 'Monad' m => 'Fold' s (m a) -> s -> m () 1061-- 'sequenceOf_' :: 'Monad' m => 'Lens'' s (m a) -> s -> m () 1062-- 'sequenceOf_' :: 'Monad' m => 'Iso'' s (m a) -> s -> m () 1063-- 'sequenceOf_' :: 'Monad' m => 'Traversal'' s (m a) -> s -> m () 1064-- 'sequenceOf_' :: 'Monad' m => 'Prism'' s (m a) -> s -> m () 1065-- @ 1066sequenceOf_ :: Monad m => Getting (Sequenced a m) s (m a) -> s -> m () 1067sequenceOf_ l = liftM skip . getSequenced #. foldMapOf l Sequenced 1068{-# INLINE sequenceOf_ #-} 1069 1070-- | The sum of a collection of actions, generalizing 'concatOf'. 1071-- 1072-- >>> asumOf both ("hello","world") 1073-- "helloworld" 1074-- 1075-- >>> asumOf each (Nothing, Just "hello", Nothing) 1076-- Just "hello" 1077-- 1078-- @ 1079-- 'asum' ≡ 'asumOf' 'folded' 1080-- @ 1081-- 1082-- @ 1083-- 'asumOf' :: 'Alternative' f => 'Getter' s (f a) -> s -> f a 1084-- 'asumOf' :: 'Alternative' f => 'Fold' s (f a) -> s -> f a 1085-- 'asumOf' :: 'Alternative' f => 'Lens'' s (f a) -> s -> f a 1086-- 'asumOf' :: 'Alternative' f => 'Iso'' s (f a) -> s -> f a 1087-- 'asumOf' :: 'Alternative' f => 'Traversal'' s (f a) -> s -> f a 1088-- 'asumOf' :: 'Alternative' f => 'Prism'' s (f a) -> s -> f a 1089-- @ 1090asumOf :: Alternative f => Getting (Endo (f a)) s (f a) -> s -> f a 1091asumOf l = foldrOf l (<|>) empty 1092{-# INLINE asumOf #-} 1093 1094-- | The sum of a collection of actions, generalizing 'concatOf'. 1095-- 1096-- >>> msumOf both ("hello","world") 1097-- "helloworld" 1098-- 1099-- >>> msumOf each (Nothing, Just "hello", Nothing) 1100-- Just "hello" 1101-- 1102-- @ 1103-- 'msum' ≡ 'msumOf' 'folded' 1104-- @ 1105-- 1106-- @ 1107-- 'msumOf' :: 'MonadPlus' m => 'Getter' s (m a) -> s -> m a 1108-- 'msumOf' :: 'MonadPlus' m => 'Fold' s (m a) -> s -> m a 1109-- 'msumOf' :: 'MonadPlus' m => 'Lens'' s (m a) -> s -> m a 1110-- 'msumOf' :: 'MonadPlus' m => 'Iso'' s (m a) -> s -> m a 1111-- 'msumOf' :: 'MonadPlus' m => 'Traversal'' s (m a) -> s -> m a 1112-- 'msumOf' :: 'MonadPlus' m => 'Prism'' s (m a) -> s -> m a 1113-- @ 1114msumOf :: MonadPlus m => Getting (Endo (m a)) s (m a) -> s -> m a 1115msumOf l = foldrOf l mplus mzero 1116{-# INLINE msumOf #-} 1117 1118-- | Does the element occur anywhere within a given 'Fold' of the structure? 1119-- 1120-- >>> elemOf both "hello" ("hello","world") 1121-- True 1122-- 1123-- @ 1124-- 'elem' ≡ 'elemOf' 'folded' 1125-- @ 1126-- 1127-- @ 1128-- 'elemOf' :: 'Eq' a => 'Getter' s a -> a -> s -> 'Bool' 1129-- 'elemOf' :: 'Eq' a => 'Fold' s a -> a -> s -> 'Bool' 1130-- 'elemOf' :: 'Eq' a => 'Lens'' s a -> a -> s -> 'Bool' 1131-- 'elemOf' :: 'Eq' a => 'Iso'' s a -> a -> s -> 'Bool' 1132-- 'elemOf' :: 'Eq' a => 'Traversal'' s a -> a -> s -> 'Bool' 1133-- 'elemOf' :: 'Eq' a => 'Prism'' s a -> a -> s -> 'Bool' 1134-- @ 1135elemOf :: Eq a => Getting Any s a -> a -> s -> Bool 1136elemOf l = anyOf l . (==) 1137{-# INLINE elemOf #-} 1138 1139-- | Does the element not occur anywhere within a given 'Fold' of the structure? 1140-- 1141-- >>> notElemOf each 'd' ('a','b','c') 1142-- True 1143-- 1144-- >>> notElemOf each 'a' ('a','b','c') 1145-- False 1146-- 1147-- @ 1148-- 'notElem' ≡ 'notElemOf' 'folded' 1149-- @ 1150-- 1151-- @ 1152-- 'notElemOf' :: 'Eq' a => 'Getter' s a -> a -> s -> 'Bool' 1153-- 'notElemOf' :: 'Eq' a => 'Fold' s a -> a -> s -> 'Bool' 1154-- 'notElemOf' :: 'Eq' a => 'Iso'' s a -> a -> s -> 'Bool' 1155-- 'notElemOf' :: 'Eq' a => 'Lens'' s a -> a -> s -> 'Bool' 1156-- 'notElemOf' :: 'Eq' a => 'Traversal'' s a -> a -> s -> 'Bool' 1157-- 'notElemOf' :: 'Eq' a => 'Prism'' s a -> a -> s -> 'Bool' 1158-- @ 1159notElemOf :: Eq a => Getting All s a -> a -> s -> Bool 1160notElemOf l = allOf l . (/=) 1161{-# INLINE notElemOf #-} 1162 1163-- | Map a function over all the targets of a 'Fold' of a container and concatenate the resulting lists. 1164-- 1165-- >>> concatMapOf both (\x -> [x, x + 1]) (1,3) 1166-- [1,2,3,4] 1167-- 1168-- @ 1169-- 'concatMap' ≡ 'concatMapOf' 'folded' 1170-- @ 1171-- 1172-- @ 1173-- 'concatMapOf' :: 'Getter' s a -> (a -> [r]) -> s -> [r] 1174-- 'concatMapOf' :: 'Fold' s a -> (a -> [r]) -> s -> [r] 1175-- 'concatMapOf' :: 'Lens'' s a -> (a -> [r]) -> s -> [r] 1176-- 'concatMapOf' :: 'Iso'' s a -> (a -> [r]) -> s -> [r] 1177-- 'concatMapOf' :: 'Traversal'' s a -> (a -> [r]) -> s -> [r] 1178-- @ 1179concatMapOf :: Getting [r] s a -> (a -> [r]) -> s -> [r] 1180concatMapOf l ces = getConst #. l (Const #. ces) 1181{-# INLINE concatMapOf #-} 1182 1183-- | Concatenate all of the lists targeted by a 'Fold' into a longer list. 1184-- 1185-- >>> concatOf both ("pan","ama") 1186-- "panama" 1187-- 1188-- @ 1189-- 'concat' ≡ 'concatOf' 'folded' 1190-- 'concatOf' ≡ 'view' 1191-- @ 1192-- 1193-- @ 1194-- 'concatOf' :: 'Getter' s [r] -> s -> [r] 1195-- 'concatOf' :: 'Fold' s [r] -> s -> [r] 1196-- 'concatOf' :: 'Iso'' s [r] -> s -> [r] 1197-- 'concatOf' :: 'Lens'' s [r] -> s -> [r] 1198-- 'concatOf' :: 'Traversal'' s [r] -> s -> [r] 1199-- @ 1200concatOf :: Getting [r] s [r] -> s -> [r] 1201concatOf l = getConst #. l Const 1202{-# INLINE concatOf #-} 1203 1204 1205-- | Calculate the number of targets there are for a 'Fold' in a given container. 1206-- 1207-- /Note:/ This can be rather inefficient for large containers and just like 'length', 1208-- this will not terminate for infinite folds. 1209-- 1210-- @ 1211-- 'length' ≡ 'lengthOf' 'folded' 1212-- @ 1213-- 1214-- >>> lengthOf _1 ("hello",()) 1215-- 1 1216-- 1217-- >>> lengthOf traverse [1..10] 1218-- 10 1219-- 1220-- >>> lengthOf (traverse.traverse) [[1,2],[3,4],[5,6]] 1221-- 6 1222-- 1223-- @ 1224-- 'lengthOf' ('folded' '.' 'folded') :: ('Foldable' f, 'Foldable' g) => f (g a) -> 'Int' 1225-- @ 1226-- 1227-- @ 1228-- 'lengthOf' :: 'Getter' s a -> s -> 'Int' 1229-- 'lengthOf' :: 'Fold' s a -> s -> 'Int' 1230-- 'lengthOf' :: 'Lens'' s a -> s -> 'Int' 1231-- 'lengthOf' :: 'Iso'' s a -> s -> 'Int' 1232-- 'lengthOf' :: 'Traversal'' s a -> s -> 'Int' 1233-- @ 1234lengthOf :: Getting (Endo (Endo Int)) s a -> s -> Int 1235lengthOf l = foldlOf' l (\a _ -> a + 1) 0 1236{-# INLINE lengthOf #-} 1237 1238-- | Perform a safe 'head' of a 'Fold' or 'Traversal' or retrieve 'Just' the result 1239-- from a 'Getter' or 'Lens'. 1240-- 1241-- When using a 'Traversal' as a partial 'Lens', or a 'Fold' as a partial 'Getter' this can be a convenient 1242-- way to extract the optional value. 1243-- 1244-- Note: if you get stack overflows due to this, you may want to use 'firstOf' instead, which can deal 1245-- more gracefully with heavily left-biased trees. This is because '^?' works by using the 1246-- 'Data.Monoid.First' monoid, which can occasionally cause space leaks. 1247-- 1248-- >>> Left 4 ^?_Left 1249-- Just 4 1250-- 1251-- >>> Right 4 ^?_Left 1252-- Nothing 1253-- 1254-- >>> "world" ^? ix 3 1255-- Just 'l' 1256-- 1257-- >>> "world" ^? ix 20 1258-- Nothing 1259-- 1260-- This operator works as an infix version of 'preview'. 1261-- 1262-- @ 1263-- ('^?') ≡ 'flip' 'preview' 1264-- @ 1265-- 1266-- It may be helpful to think of '^?' as having one of the following 1267-- more specialized types: 1268-- 1269-- @ 1270-- ('^?') :: s -> 'Getter' s a -> 'Maybe' a 1271-- ('^?') :: s -> 'Fold' s a -> 'Maybe' a 1272-- ('^?') :: s -> 'Lens'' s a -> 'Maybe' a 1273-- ('^?') :: s -> 'Iso'' s a -> 'Maybe' a 1274-- ('^?') :: s -> 'Traversal'' s a -> 'Maybe' a 1275-- @ 1276(^?) :: s -> Getting (First a) s a -> Maybe a 1277s ^? l = getFirst (foldMapOf l (First #. Just) s) 1278{-# INLINE (^?) #-} 1279 1280-- | Perform an *UNSAFE* 'head' of a 'Fold' or 'Traversal' assuming that it is there. 1281-- 1282-- >>> Left 4 ^?! _Left 1283-- 4 1284-- 1285-- >>> "world" ^?! ix 3 1286-- 'l' 1287-- 1288-- @ 1289-- ('^?!') :: s -> 'Getter' s a -> a 1290-- ('^?!') :: s -> 'Fold' s a -> a 1291-- ('^?!') :: s -> 'Lens'' s a -> a 1292-- ('^?!') :: s -> 'Iso'' s a -> a 1293-- ('^?!') :: s -> 'Traversal'' s a -> a 1294-- @ 1295(^?!) :: HasCallStack => s -> Getting (Endo a) s a -> a 1296s ^?! l = foldrOf l const (error "(^?!): empty Fold") s 1297{-# INLINE (^?!) #-} 1298 1299-- | Retrieve the 'First' entry of a 'Fold' or 'Traversal' or retrieve 'Just' the result 1300-- from a 'Getter' or 'Lens'. 1301-- 1302-- The answer is computed in a manner that leaks space less than @'preview'@ or @^?'@ 1303-- and gives you back access to the outermost 'Just' constructor more quickly, but does so 1304-- in a way that builds an intermediate structure, and thus may have worse 1305-- constant factors. This also means that it can not be used in any 'Control.Monad.Reader.MonadReader', 1306-- but must instead have 's' passed as its last argument, unlike 'preview'. 1307-- 1308-- Note: this could been named `headOf`. 1309-- 1310-- >>> firstOf traverse [1..10] 1311-- Just 1 1312-- 1313-- >>> firstOf both (1,2) 1314-- Just 1 1315-- 1316-- >>> firstOf ignored () 1317-- Nothing 1318-- 1319-- @ 1320-- 'firstOf' :: 'Getter' s a -> s -> 'Maybe' a 1321-- 'firstOf' :: 'Fold' s a -> s -> 'Maybe' a 1322-- 'firstOf' :: 'Lens'' s a -> s -> 'Maybe' a 1323-- 'firstOf' :: 'Iso'' s a -> s -> 'Maybe' a 1324-- 'firstOf' :: 'Traversal'' s a -> s -> 'Maybe' a 1325-- @ 1326firstOf :: Getting (Leftmost a) s a -> s -> Maybe a 1327firstOf l = getLeftmost . foldMapOf l LLeaf 1328{-# INLINE firstOf #-} 1329 1330-- | Retrieve the 'Data.Semigroup.First' entry of a 'Fold1' or 'Traversal1' or the result from a 'Getter' or 'Lens'. 1331-- 1332-- >>> first1Of traverse1 (1 :| [2..10]) 1333-- 1 1334-- 1335-- >>> first1Of both1 (1,2) 1336-- 1 1337-- 1338-- /Note:/ this is different from '^.'. 1339-- 1340-- >>> first1Of traverse1 ([1,2] :| [[3,4],[5,6]]) 1341-- [1,2] 1342-- 1343-- >>> ([1,2] :| [[3,4],[5,6]]) ^. traverse1 1344-- [1,2,3,4,5,6] 1345-- 1346-- @ 1347-- 'first1Of' :: 'Getter' s a -> s -> a 1348-- 'first1Of' :: 'Fold1' s a -> s -> a 1349-- 'first1Of' :: 'Lens'' s a -> s -> a 1350-- 'first1Of' :: 'Iso'' s a -> s -> a 1351-- 'first1Of' :: 'Traversal1'' s a -> s -> a 1352-- @ 1353first1Of :: Getting (Semi.First a) s a -> s -> a 1354first1Of l = Semi.getFirst . foldMapOf l Semi.First 1355 1356-- | Retrieve the 'Last' entry of a 'Fold' or 'Traversal' or retrieve 'Just' the result 1357-- from a 'Getter' or 'Lens'. 1358-- 1359-- The answer is computed in a manner that leaks space less than @'ala' 'Last' '.' 'foldMapOf'@ 1360-- and gives you back access to the outermost 'Just' constructor more quickly, but may have worse 1361-- constant factors. 1362-- 1363-- >>> lastOf traverse [1..10] 1364-- Just 10 1365-- 1366-- >>> lastOf both (1,2) 1367-- Just 2 1368-- 1369-- >>> lastOf ignored () 1370-- Nothing 1371-- 1372-- @ 1373-- 'lastOf' :: 'Getter' s a -> s -> 'Maybe' a 1374-- 'lastOf' :: 'Fold' s a -> s -> 'Maybe' a 1375-- 'lastOf' :: 'Lens'' s a -> s -> 'Maybe' a 1376-- 'lastOf' :: 'Iso'' s a -> s -> 'Maybe' a 1377-- 'lastOf' :: 'Traversal'' s a -> s -> 'Maybe' a 1378-- @ 1379lastOf :: Getting (Rightmost a) s a -> s -> Maybe a 1380lastOf l = getRightmost . foldMapOf l RLeaf 1381{-# INLINE lastOf #-} 1382 1383-- | Retrieve the 'Data.Semigroup.Last' entry of a 'Fold1' or 'Traversal1' or retrieve the result 1384-- from a 'Getter' or 'Lens'.o 1385-- 1386-- >>> last1Of traverse1 (1 :| [2..10]) 1387-- 10 1388-- 1389-- >>> last1Of both1 (1,2) 1390-- 2 1391-- 1392-- @ 1393-- 'last1Of' :: 'Getter' s a -> s -> 'Maybe' a 1394-- 'last1Of' :: 'Fold1' s a -> s -> 'Maybe' a 1395-- 'last1Of' :: 'Lens'' s a -> s -> 'Maybe' a 1396-- 'last1Of' :: 'Iso'' s a -> s -> 'Maybe' a 1397-- 'last1Of' :: 'Traversal1'' s a -> s -> 'Maybe' a 1398-- @ 1399last1Of :: Getting (Semi.Last a) s a -> s -> a 1400last1Of l = Semi.getLast . foldMapOf l Semi.Last 1401 1402-- | Returns 'True' if this 'Fold' or 'Traversal' has no targets in the given container. 1403-- 1404-- Note: 'nullOf' on a valid 'Iso', 'Lens' or 'Getter' should always return 'False'. 1405-- 1406-- @ 1407-- 'null' ≡ 'nullOf' 'folded' 1408-- @ 1409-- 1410-- This may be rather inefficient compared to the 'null' check of many containers. 1411-- 1412-- >>> nullOf _1 (1,2) 1413-- False 1414-- 1415-- >>> nullOf ignored () 1416-- True 1417-- 1418-- >>> nullOf traverse [] 1419-- True 1420-- 1421-- >>> nullOf (element 20) [1..10] 1422-- True 1423-- 1424-- @ 1425-- 'nullOf' ('folded' '.' '_1' '.' 'folded') :: ('Foldable' f, 'Foldable' g) => f (g a, b) -> 'Bool' 1426-- @ 1427-- 1428-- @ 1429-- 'nullOf' :: 'Getter' s a -> s -> 'Bool' 1430-- 'nullOf' :: 'Fold' s a -> s -> 'Bool' 1431-- 'nullOf' :: 'Iso'' s a -> s -> 'Bool' 1432-- 'nullOf' :: 'Lens'' s a -> s -> 'Bool' 1433-- 'nullOf' :: 'Traversal'' s a -> s -> 'Bool' 1434-- @ 1435nullOf :: Getting All s a -> s -> Bool 1436nullOf = hasn't 1437{-# INLINE nullOf #-} 1438 1439-- | Returns 'True' if this 'Fold' or 'Traversal' has any targets in the given container. 1440-- 1441-- A more \"conversational\" alias for this combinator is 'has'. 1442-- 1443-- Note: 'notNullOf' on a valid 'Iso', 'Lens' or 'Getter' should always return 'True'. 1444-- 1445-- @ 1446-- 'not' '.' 'null' ≡ 'notNullOf' 'folded' 1447-- @ 1448-- 1449-- This may be rather inefficient compared to the @'not' '.' 'null'@ check of many containers. 1450-- 1451-- >>> notNullOf _1 (1,2) 1452-- True 1453-- 1454-- >>> notNullOf traverse [1..10] 1455-- True 1456-- 1457-- >>> notNullOf folded [] 1458-- False 1459-- 1460-- >>> notNullOf (element 20) [1..10] 1461-- False 1462-- 1463-- @ 1464-- 'notNullOf' ('folded' '.' '_1' '.' 'folded') :: ('Foldable' f, 'Foldable' g) => f (g a, b) -> 'Bool' 1465-- @ 1466-- 1467-- @ 1468-- 'notNullOf' :: 'Getter' s a -> s -> 'Bool' 1469-- 'notNullOf' :: 'Fold' s a -> s -> 'Bool' 1470-- 'notNullOf' :: 'Iso'' s a -> s -> 'Bool' 1471-- 'notNullOf' :: 'Lens'' s a -> s -> 'Bool' 1472-- 'notNullOf' :: 'Traversal'' s a -> s -> 'Bool' 1473-- @ 1474notNullOf :: Getting Any s a -> s -> Bool 1475notNullOf = has 1476{-# INLINE notNullOf #-} 1477 1478-- | Obtain the maximum element (if any) targeted by a 'Fold' or 'Traversal' safely. 1479-- 1480-- Note: 'maximumOf' on a valid 'Iso', 'Lens' or 'Getter' will always return 'Just' a value. 1481-- 1482-- >>> maximumOf traverse [1..10] 1483-- Just 10 1484-- 1485-- >>> maximumOf traverse [] 1486-- Nothing 1487-- 1488-- >>> maximumOf (folded.filtered even) [1,4,3,6,7,9,2] 1489-- Just 6 1490-- 1491-- @ 1492-- 'maximum' ≡ 'fromMaybe' ('error' \"empty\") '.' 'maximumOf' 'folded' 1493-- @ 1494-- 1495-- In the interest of efficiency, This operation has semantics more strict than strictly necessary. 1496-- @'rmap' 'getMax' ('foldMapOf' l 'Max')@ has lazier semantics but could leak memory. 1497-- 1498-- @ 1499-- 'maximumOf' :: 'Ord' a => 'Getter' s a -> s -> 'Maybe' a 1500-- 'maximumOf' :: 'Ord' a => 'Fold' s a -> s -> 'Maybe' a 1501-- 'maximumOf' :: 'Ord' a => 'Iso'' s a -> s -> 'Maybe' a 1502-- 'maximumOf' :: 'Ord' a => 'Lens'' s a -> s -> 'Maybe' a 1503-- 'maximumOf' :: 'Ord' a => 'Traversal'' s a -> s -> 'Maybe' a 1504-- @ 1505maximumOf :: Ord a => Getting (Endo (Endo (Maybe a))) s a -> s -> Maybe a 1506maximumOf l = foldlOf' l mf Nothing where 1507 mf Nothing y = Just $! y 1508 mf (Just x) y = Just $! max x y 1509{-# INLINE maximumOf #-} 1510 1511-- | Obtain the maximum element targeted by a 'Fold1' or 'Traversal1'. 1512-- 1513-- >>> maximum1Of traverse1 (1 :| [2..10]) 1514-- 10 1515-- 1516-- @ 1517-- 'maximum1Of' :: 'Ord' a => 'Getter' s a -> s -> a 1518-- 'maximum1Of' :: 'Ord' a => 'Fold1' s a -> s -> a 1519-- 'maximum1Of' :: 'Ord' a => 'Iso'' s a -> s -> a 1520-- 'maximum1Of' :: 'Ord' a => 'Lens'' s a -> s -> a 1521-- 'maximum1Of' :: 'Ord' a => 'Traversal1'' s a -> s -> a 1522-- @ 1523maximum1Of :: Ord a => Getting (Semi.Max a) s a -> s -> a 1524maximum1Of l = Semi.getMax . foldMapOf l Semi.Max 1525{-# INLINE maximum1Of #-} 1526 1527-- | Obtain the minimum element (if any) targeted by a 'Fold' or 'Traversal' safely. 1528-- 1529-- Note: 'minimumOf' on a valid 'Iso', 'Lens' or 'Getter' will always return 'Just' a value. 1530-- 1531-- >>> minimumOf traverse [1..10] 1532-- Just 1 1533-- 1534-- >>> minimumOf traverse [] 1535-- Nothing 1536-- 1537-- >>> minimumOf (folded.filtered even) [1,4,3,6,7,9,2] 1538-- Just 2 1539-- 1540-- @ 1541-- 'minimum' ≡ 'Data.Maybe.fromMaybe' ('error' \"empty\") '.' 'minimumOf' 'folded' 1542-- @ 1543-- 1544-- In the interest of efficiency, This operation has semantics more strict than strictly necessary. 1545-- @'rmap' 'getMin' ('foldMapOf' l 'Min')@ has lazier semantics but could leak memory. 1546-- 1547-- 1548-- @ 1549-- 'minimumOf' :: 'Ord' a => 'Getter' s a -> s -> 'Maybe' a 1550-- 'minimumOf' :: 'Ord' a => 'Fold' s a -> s -> 'Maybe' a 1551-- 'minimumOf' :: 'Ord' a => 'Iso'' s a -> s -> 'Maybe' a 1552-- 'minimumOf' :: 'Ord' a => 'Lens'' s a -> s -> 'Maybe' a 1553-- 'minimumOf' :: 'Ord' a => 'Traversal'' s a -> s -> 'Maybe' a 1554-- @ 1555minimumOf :: Ord a => Getting (Endo (Endo (Maybe a))) s a -> s -> Maybe a 1556minimumOf l = foldlOf' l mf Nothing where 1557 mf Nothing y = Just $! y 1558 mf (Just x) y = Just $! min x y 1559{-# INLINE minimumOf #-} 1560 1561-- | Obtain the minimum element targeted by a 'Fold1' or 'Traversal1'. 1562-- 1563-- >>> minimum1Of traverse1 (1 :| [2..10]) 1564-- 1 1565-- 1566-- @ 1567-- 'minimum1Of' :: 'Ord' a => 'Getter' s a -> s -> a 1568-- 'minimum1Of' :: 'Ord' a => 'Fold1' s a -> s -> a 1569-- 'minimum1Of' :: 'Ord' a => 'Iso'' s a -> s -> a 1570-- 'minimum1Of' :: 'Ord' a => 'Lens'' s a -> s -> a 1571-- 'minimum1Of' :: 'Ord' a => 'Traversal1'' s a -> s -> a 1572-- @ 1573minimum1Of :: Ord a => Getting (Semi.Min a) s a -> s -> a 1574minimum1Of l = Semi.getMin . foldMapOf l Semi.Min 1575{-# INLINE minimum1Of #-} 1576 1577-- | Obtain the maximum element (if any) targeted by a 'Fold', 'Traversal', 'Lens', 'Iso', 1578-- or 'Getter' according to a user supplied 'Ordering'. 1579-- 1580-- >>> maximumByOf traverse (compare `on` length) ["mustard","relish","ham"] 1581-- Just "mustard" 1582-- 1583-- In the interest of efficiency, This operation has semantics more strict than strictly necessary. 1584-- 1585-- @ 1586-- 'Data.Foldable.maximumBy' cmp ≡ 'Data.Maybe.fromMaybe' ('error' \"empty\") '.' 'maximumByOf' 'folded' cmp 1587-- @ 1588-- 1589-- @ 1590-- 'maximumByOf' :: 'Getter' s a -> (a -> a -> 'Ordering') -> s -> 'Maybe' a 1591-- 'maximumByOf' :: 'Fold' s a -> (a -> a -> 'Ordering') -> s -> 'Maybe' a 1592-- 'maximumByOf' :: 'Iso'' s a -> (a -> a -> 'Ordering') -> s -> 'Maybe' a 1593-- 'maximumByOf' :: 'Lens'' s a -> (a -> a -> 'Ordering') -> s -> 'Maybe' a 1594-- 'maximumByOf' :: 'Traversal'' s a -> (a -> a -> 'Ordering') -> s -> 'Maybe' a 1595-- @ 1596maximumByOf :: Getting (Endo (Endo (Maybe a))) s a -> (a -> a -> Ordering) -> s -> Maybe a 1597maximumByOf l cmp = foldlOf' l mf Nothing where 1598 mf Nothing y = Just $! y 1599 mf (Just x) y = Just $! if cmp x y == GT then x else y 1600{-# INLINE maximumByOf #-} 1601 1602-- | Obtain the minimum element (if any) targeted by a 'Fold', 'Traversal', 'Lens', 'Iso' 1603-- or 'Getter' according to a user supplied 'Ordering'. 1604-- 1605-- In the interest of efficiency, This operation has semantics more strict than strictly necessary. 1606-- 1607-- >>> minimumByOf traverse (compare `on` length) ["mustard","relish","ham"] 1608-- Just "ham" 1609-- 1610-- @ 1611-- 'minimumBy' cmp ≡ 'Data.Maybe.fromMaybe' ('error' \"empty\") '.' 'minimumByOf' 'folded' cmp 1612-- @ 1613-- 1614-- @ 1615-- 'minimumByOf' :: 'Getter' s a -> (a -> a -> 'Ordering') -> s -> 'Maybe' a 1616-- 'minimumByOf' :: 'Fold' s a -> (a -> a -> 'Ordering') -> s -> 'Maybe' a 1617-- 'minimumByOf' :: 'Iso'' s a -> (a -> a -> 'Ordering') -> s -> 'Maybe' a 1618-- 'minimumByOf' :: 'Lens'' s a -> (a -> a -> 'Ordering') -> s -> 'Maybe' a 1619-- 'minimumByOf' :: 'Traversal'' s a -> (a -> a -> 'Ordering') -> s -> 'Maybe' a 1620-- @ 1621minimumByOf :: Getting (Endo (Endo (Maybe a))) s a -> (a -> a -> Ordering) -> s -> Maybe a 1622minimumByOf l cmp = foldlOf' l mf Nothing where 1623 mf Nothing y = Just $! y 1624 mf (Just x) y = Just $! if cmp x y == GT then y else x 1625{-# INLINE minimumByOf #-} 1626 1627-- | The 'findOf' function takes a 'Lens' (or 'Getter', 'Iso', 'Fold', or 'Traversal'), 1628-- a predicate and a structure and returns the leftmost element of the structure 1629-- matching the predicate, or 'Nothing' if there is no such element. 1630-- 1631-- >>> findOf each even (1,3,4,6) 1632-- Just 4 1633-- 1634-- >>> findOf folded even [1,3,5,7] 1635-- Nothing 1636-- 1637-- @ 1638-- 'findOf' :: 'Getter' s a -> (a -> 'Bool') -> s -> 'Maybe' a 1639-- 'findOf' :: 'Fold' s a -> (a -> 'Bool') -> s -> 'Maybe' a 1640-- 'findOf' :: 'Iso'' s a -> (a -> 'Bool') -> s -> 'Maybe' a 1641-- 'findOf' :: 'Lens'' s a -> (a -> 'Bool') -> s -> 'Maybe' a 1642-- 'findOf' :: 'Traversal'' s a -> (a -> 'Bool') -> s -> 'Maybe' a 1643-- @ 1644-- 1645-- @ 1646-- 'Data.Foldable.find' ≡ 'findOf' 'folded' 1647-- 'ifindOf' l ≡ 'findOf' l '.' 'Indexed' 1648-- @ 1649-- 1650-- A simpler version that didn't permit indexing, would be: 1651-- 1652-- @ 1653-- 'findOf' :: 'Getting' ('Endo' ('Maybe' a)) s a -> (a -> 'Bool') -> s -> 'Maybe' a 1654-- 'findOf' l p = 'foldrOf' l (\a y -> if p a then 'Just' a else y) 'Nothing' 1655-- @ 1656findOf :: Getting (Endo (Maybe a)) s a -> (a -> Bool) -> s -> Maybe a 1657findOf l f = foldrOf l (\a y -> if f a then Just a else y) Nothing 1658{-# INLINE findOf #-} 1659 1660-- | The 'findMOf' function takes a 'Lens' (or 'Getter', 'Iso', 'Fold', or 'Traversal'), 1661-- a monadic predicate and a structure and returns in the monad the leftmost element of the structure 1662-- matching the predicate, or 'Nothing' if there is no such element. 1663-- 1664-- >>> findMOf each ( \x -> print ("Checking " ++ show x) >> return (even x)) (1,3,4,6) 1665-- "Checking 1" 1666-- "Checking 3" 1667-- "Checking 4" 1668-- Just 4 1669-- 1670-- >>> findMOf each ( \x -> print ("Checking " ++ show x) >> return (even x)) (1,3,5,7) 1671-- "Checking 1" 1672-- "Checking 3" 1673-- "Checking 5" 1674-- "Checking 7" 1675-- Nothing 1676-- 1677-- @ 1678-- 'findMOf' :: ('Monad' m, 'Getter' s a) -> (a -> m 'Bool') -> s -> m ('Maybe' a) 1679-- 'findMOf' :: ('Monad' m, 'Fold' s a) -> (a -> m 'Bool') -> s -> m ('Maybe' a) 1680-- 'findMOf' :: ('Monad' m, 'Iso'' s a) -> (a -> m 'Bool') -> s -> m ('Maybe' a) 1681-- 'findMOf' :: ('Monad' m, 'Lens'' s a) -> (a -> m 'Bool') -> s -> m ('Maybe' a) 1682-- 'findMOf' :: ('Monad' m, 'Traversal'' s a) -> (a -> m 'Bool') -> s -> m ('Maybe' a) 1683-- @ 1684-- 1685-- @ 1686-- 'findMOf' 'folded' :: (Monad m, Foldable f) => (a -> m Bool) -> f a -> m (Maybe a) 1687-- 'ifindMOf' l ≡ 'findMOf' l '.' 'Indexed' 1688-- @ 1689-- 1690-- A simpler version that didn't permit indexing, would be: 1691-- 1692-- @ 1693-- 'findMOf' :: Monad m => 'Getting' ('Endo' (m ('Maybe' a))) s a -> (a -> m 'Bool') -> s -> m ('Maybe' a) 1694-- 'findMOf' l p = 'foldrOf' l (\a y -> p a >>= \x -> if x then return ('Just' a) else y) $ return 'Nothing' 1695-- @ 1696findMOf :: Monad m => Getting (Endo (m (Maybe a))) s a -> (a -> m Bool) -> s -> m (Maybe a) 1697findMOf l f = foldrOf l (\a y -> f a >>= \r -> if r then return (Just a) else y) $ return Nothing 1698{-# INLINE findMOf #-} 1699 1700-- | The 'lookupOf' function takes a 'Fold' (or 'Getter', 'Traversal', 1701-- 'Lens', 'Iso', etc.), a key, and a structure containing key/value pairs. 1702-- It returns the first value corresponding to the given key. This function 1703-- generalizes 'lookup' to work on an arbitrary 'Fold' instead of lists. 1704-- 1705-- >>> lookupOf folded 4 [(2, 'a'), (4, 'b'), (4, 'c')] 1706-- Just 'b' 1707-- 1708-- >>> lookupOf each 2 [(2, 'a'), (4, 'b'), (4, 'c')] 1709-- Just 'a' 1710-- 1711-- @ 1712-- 'lookupOf' :: 'Eq' k => 'Fold' s (k,v) -> k -> s -> 'Maybe' v 1713-- @ 1714lookupOf :: Eq k => Getting (Endo (Maybe v)) s (k,v) -> k -> s -> Maybe v 1715lookupOf l k = foldrOf l (\(k',v) next -> if k == k' then Just v else next) Nothing 1716{-# INLINE lookupOf #-} 1717 1718-- | A variant of 'foldrOf' that has no base case and thus may only be applied 1719-- to lenses and structures such that the 'Lens' views at least one element of 1720-- the structure. 1721-- 1722-- >>> foldr1Of each (+) (1,2,3,4) 1723-- 10 1724-- 1725-- @ 1726-- 'foldr1Of' l f ≡ 'Prelude.foldr1' f '.' 'toListOf' l 1727-- 'Data.Foldable.foldr1' ≡ 'foldr1Of' 'folded' 1728-- @ 1729-- 1730-- @ 1731-- 'foldr1Of' :: 'Getter' s a -> (a -> a -> a) -> s -> a 1732-- 'foldr1Of' :: 'Fold' s a -> (a -> a -> a) -> s -> a 1733-- 'foldr1Of' :: 'Iso'' s a -> (a -> a -> a) -> s -> a 1734-- 'foldr1Of' :: 'Lens'' s a -> (a -> a -> a) -> s -> a 1735-- 'foldr1Of' :: 'Traversal'' s a -> (a -> a -> a) -> s -> a 1736-- @ 1737foldr1Of :: HasCallStack => Getting (Endo (Maybe a)) s a -> (a -> a -> a) -> s -> a 1738foldr1Of l f xs = fromMaybe (error "foldr1Of: empty structure") 1739 (foldrOf l mf Nothing xs) where 1740 mf x my = Just $ case my of 1741 Nothing -> x 1742 Just y -> f x y 1743{-# INLINE foldr1Of #-} 1744 1745-- | A variant of 'foldlOf' that has no base case and thus may only be applied to lenses and structures such 1746-- that the 'Lens' views at least one element of the structure. 1747-- 1748-- >>> foldl1Of each (+) (1,2,3,4) 1749-- 10 1750-- 1751-- @ 1752-- 'foldl1Of' l f ≡ 'Prelude.foldl1' f '.' 'toListOf' l 1753-- 'Data.Foldable.foldl1' ≡ 'foldl1Of' 'folded' 1754-- @ 1755-- 1756-- @ 1757-- 'foldl1Of' :: 'Getter' s a -> (a -> a -> a) -> s -> a 1758-- 'foldl1Of' :: 'Fold' s a -> (a -> a -> a) -> s -> a 1759-- 'foldl1Of' :: 'Iso'' s a -> (a -> a -> a) -> s -> a 1760-- 'foldl1Of' :: 'Lens'' s a -> (a -> a -> a) -> s -> a 1761-- 'foldl1Of' :: 'Traversal'' s a -> (a -> a -> a) -> s -> a 1762-- @ 1763foldl1Of :: HasCallStack => Getting (Dual (Endo (Maybe a))) s a -> (a -> a -> a) -> s -> a 1764foldl1Of l f xs = fromMaybe (error "foldl1Of: empty structure") (foldlOf l mf Nothing xs) where 1765 mf mx y = Just $ case mx of 1766 Nothing -> y 1767 Just x -> f x y 1768{-# INLINE foldl1Of #-} 1769 1770-- | Strictly fold right over the elements of a structure. 1771-- 1772-- @ 1773-- 'Data.Foldable.foldr'' ≡ 'foldrOf'' 'folded' 1774-- @ 1775-- 1776-- @ 1777-- 'foldrOf'' :: 'Getter' s a -> (a -> r -> r) -> r -> s -> r 1778-- 'foldrOf'' :: 'Fold' s a -> (a -> r -> r) -> r -> s -> r 1779-- 'foldrOf'' :: 'Iso'' s a -> (a -> r -> r) -> r -> s -> r 1780-- 'foldrOf'' :: 'Lens'' s a -> (a -> r -> r) -> r -> s -> r 1781-- 'foldrOf'' :: 'Traversal'' s a -> (a -> r -> r) -> r -> s -> r 1782-- @ 1783foldrOf' :: Getting (Dual (Endo (Endo r))) s a -> (a -> r -> r) -> r -> s -> r 1784foldrOf' l f z0 xs = foldlOf l f' (Endo id) xs `appEndo` z0 1785 where f' (Endo k) x = Endo $ \ z -> k $! f x z 1786{-# INLINE foldrOf' #-} 1787 1788-- | Fold over the elements of a structure, associating to the left, but strictly. 1789-- 1790-- @ 1791-- 'Data.Foldable.foldl'' ≡ 'foldlOf'' 'folded' 1792-- @ 1793-- 1794-- @ 1795-- 'foldlOf'' :: 'Getter' s a -> (r -> a -> r) -> r -> s -> r 1796-- 'foldlOf'' :: 'Fold' s a -> (r -> a -> r) -> r -> s -> r 1797-- 'foldlOf'' :: 'Iso'' s a -> (r -> a -> r) -> r -> s -> r 1798-- 'foldlOf'' :: 'Lens'' s a -> (r -> a -> r) -> r -> s -> r 1799-- 'foldlOf'' :: 'Traversal'' s a -> (r -> a -> r) -> r -> s -> r 1800-- @ 1801foldlOf' :: Getting (Endo (Endo r)) s a -> (r -> a -> r) -> r -> s -> r 1802foldlOf' l f z0 xs = foldrOf l f' (Endo id) xs `appEndo` z0 1803 where f' x (Endo k) = Endo $ \z -> k $! f z x 1804{-# INLINE foldlOf' #-} 1805 1806-- | A variant of 'foldrOf'' that has no base case and thus may only be applied 1807-- to folds and structures such that the fold views at least one element of the 1808-- structure. 1809-- 1810-- @ 1811-- 'foldr1Of' l f ≡ 'Prelude.foldr1' f '.' 'toListOf' l 1812-- @ 1813-- 1814-- @ 1815-- 'foldr1Of'' :: 'Getter' s a -> (a -> a -> a) -> s -> a 1816-- 'foldr1Of'' :: 'Fold' s a -> (a -> a -> a) -> s -> a 1817-- 'foldr1Of'' :: 'Iso'' s a -> (a -> a -> a) -> s -> a 1818-- 'foldr1Of'' :: 'Lens'' s a -> (a -> a -> a) -> s -> a 1819-- 'foldr1Of'' :: 'Traversal'' s a -> (a -> a -> a) -> s -> a 1820-- @ 1821foldr1Of' :: HasCallStack => Getting (Dual (Endo (Endo (Maybe a)))) s a -> (a -> a -> a) -> s -> a 1822foldr1Of' l f xs = fromMaybe (error "foldr1Of': empty structure") (foldrOf' l mf Nothing xs) where 1823 mf x Nothing = Just $! x 1824 mf x (Just y) = Just $! f x y 1825{-# INLINE foldr1Of' #-} 1826 1827-- | A variant of 'foldlOf'' that has no base case and thus may only be applied 1828-- to folds and structures such that the fold views at least one element of 1829-- the structure. 1830-- 1831-- @ 1832-- 'foldl1Of'' l f ≡ 'Data.List.foldl1'' f '.' 'toListOf' l 1833-- @ 1834-- 1835-- @ 1836-- 'foldl1Of'' :: 'Getter' s a -> (a -> a -> a) -> s -> a 1837-- 'foldl1Of'' :: 'Fold' s a -> (a -> a -> a) -> s -> a 1838-- 'foldl1Of'' :: 'Iso'' s a -> (a -> a -> a) -> s -> a 1839-- 'foldl1Of'' :: 'Lens'' s a -> (a -> a -> a) -> s -> a 1840-- 'foldl1Of'' :: 'Traversal'' s a -> (a -> a -> a) -> s -> a 1841-- @ 1842foldl1Of' :: HasCallStack => Getting (Endo (Endo (Maybe a))) s a -> (a -> a -> a) -> s -> a 1843foldl1Of' l f xs = fromMaybe (error "foldl1Of': empty structure") (foldlOf' l mf Nothing xs) where 1844 mf Nothing y = Just $! y 1845 mf (Just x) y = Just $! f x y 1846{-# INLINE foldl1Of' #-} 1847 1848-- | Monadic fold over the elements of a structure, associating to the right, 1849-- i.e. from right to left. 1850-- 1851-- @ 1852-- 'Data.Foldable.foldrM' ≡ 'foldrMOf' 'folded' 1853-- @ 1854-- 1855-- @ 1856-- 'foldrMOf' :: 'Monad' m => 'Getter' s a -> (a -> r -> m r) -> r -> s -> m r 1857-- 'foldrMOf' :: 'Monad' m => 'Fold' s a -> (a -> r -> m r) -> r -> s -> m r 1858-- 'foldrMOf' :: 'Monad' m => 'Iso'' s a -> (a -> r -> m r) -> r -> s -> m r 1859-- 'foldrMOf' :: 'Monad' m => 'Lens'' s a -> (a -> r -> m r) -> r -> s -> m r 1860-- 'foldrMOf' :: 'Monad' m => 'Traversal'' s a -> (a -> r -> m r) -> r -> s -> m r 1861-- @ 1862foldrMOf :: Monad m 1863 => Getting (Dual (Endo (r -> m r))) s a 1864 -> (a -> r -> m r) -> r -> s -> m r 1865foldrMOf l f z0 xs = foldlOf l f' return xs z0 1866 where f' k x z = f x z >>= k 1867{-# INLINE foldrMOf #-} 1868 1869-- | Monadic fold over the elements of a structure, associating to the left, 1870-- i.e. from left to right. 1871-- 1872-- @ 1873-- 'Data.Foldable.foldlM' ≡ 'foldlMOf' 'folded' 1874-- @ 1875-- 1876-- @ 1877-- 'foldlMOf' :: 'Monad' m => 'Getter' s a -> (r -> a -> m r) -> r -> s -> m r 1878-- 'foldlMOf' :: 'Monad' m => 'Fold' s a -> (r -> a -> m r) -> r -> s -> m r 1879-- 'foldlMOf' :: 'Monad' m => 'Iso'' s a -> (r -> a -> m r) -> r -> s -> m r 1880-- 'foldlMOf' :: 'Monad' m => 'Lens'' s a -> (r -> a -> m r) -> r -> s -> m r 1881-- 'foldlMOf' :: 'Monad' m => 'Traversal'' s a -> (r -> a -> m r) -> r -> s -> m r 1882-- @ 1883foldlMOf :: Monad m 1884 => Getting (Endo (r -> m r)) s a 1885 -> (r -> a -> m r) -> r -> s -> m r 1886foldlMOf l f z0 xs = foldrOf l f' return xs z0 1887 where f' x k z = f z x >>= k 1888{-# INLINE foldlMOf #-} 1889 1890-- | Check to see if this 'Fold' or 'Traversal' matches 1 or more entries. 1891-- 1892-- >>> has (element 0) [] 1893-- False 1894-- 1895-- >>> has _Left (Left 12) 1896-- True 1897-- 1898-- >>> has _Right (Left 12) 1899-- False 1900-- 1901-- This will always return 'True' for a 'Lens' or 'Getter'. 1902-- 1903-- >>> has _1 ("hello","world") 1904-- True 1905-- 1906-- @ 1907-- 'has' :: 'Getter' s a -> s -> 'Bool' 1908-- 'has' :: 'Fold' s a -> s -> 'Bool' 1909-- 'has' :: 'Iso'' s a -> s -> 'Bool' 1910-- 'has' :: 'Lens'' s a -> s -> 'Bool' 1911-- 'has' :: 'Traversal'' s a -> s -> 'Bool' 1912-- @ 1913has :: Getting Any s a -> s -> Bool 1914has l = getAny #. foldMapOf l (\_ -> Any True) 1915{-# INLINE has #-} 1916 1917 1918 1919-- | Check to see if this 'Fold' or 'Traversal' has no matches. 1920-- 1921-- >>> hasn't _Left (Right 12) 1922-- True 1923-- 1924-- >>> hasn't _Left (Left 12) 1925-- False 1926hasn't :: Getting All s a -> s -> Bool 1927hasn't l = getAll #. foldMapOf l (\_ -> All False) 1928{-# INLINE hasn't #-} 1929 1930------------------------------------------------------------------------------ 1931-- Pre 1932------------------------------------------------------------------------------ 1933 1934-- | This converts a 'Fold' to a 'IndexPreservingGetter' that returns the first element, if it 1935-- exists, as a 'Maybe'. 1936-- 1937-- @ 1938-- 'pre' :: 'Getter' s a -> 'IndexPreservingGetter' s ('Maybe' a) 1939-- 'pre' :: 'Fold' s a -> 'IndexPreservingGetter' s ('Maybe' a) 1940-- 'pre' :: 'Traversal'' s a -> 'IndexPreservingGetter' s ('Maybe' a) 1941-- 'pre' :: 'Lens'' s a -> 'IndexPreservingGetter' s ('Maybe' a) 1942-- 'pre' :: 'Iso'' s a -> 'IndexPreservingGetter' s ('Maybe' a) 1943-- 'pre' :: 'Prism'' s a -> 'IndexPreservingGetter' s ('Maybe' a) 1944-- @ 1945pre :: Getting (First a) s a -> IndexPreservingGetter s (Maybe a) 1946pre l = dimap (getFirst . getConst #. l (Const #. First #. Just)) phantom 1947{-# INLINE pre #-} 1948 1949-- | This converts an 'IndexedFold' to an 'IndexPreservingGetter' that returns the first index 1950-- and element, if they exist, as a 'Maybe'. 1951-- 1952-- @ 1953-- 'ipre' :: 'IndexedGetter' i s a -> 'IndexPreservingGetter' s ('Maybe' (i, a)) 1954-- 'ipre' :: 'IndexedFold' i s a -> 'IndexPreservingGetter' s ('Maybe' (i, a)) 1955-- 'ipre' :: 'IndexedTraversal'' i s a -> 'IndexPreservingGetter' s ('Maybe' (i, a)) 1956-- 'ipre' :: 'IndexedLens'' i s a -> 'IndexPreservingGetter' s ('Maybe' (i, a)) 1957-- @ 1958ipre :: IndexedGetting i (First (i, a)) s a -> IndexPreservingGetter s (Maybe (i, a)) 1959ipre l = dimap (getFirst . getConst #. l (Indexed $ \i a -> Const (First (Just (i, a))))) phantom 1960{-# INLINE ipre #-} 1961 1962------------------------------------------------------------------------------ 1963-- Preview 1964------------------------------------------------------------------------------ 1965 1966-- | Retrieve the first value targeted by a 'Fold' or 'Traversal' (or 'Just' the result 1967-- from a 'Getter' or 'Lens'). See also 'firstOf' and '^?', which are similar with 1968-- some subtle differences (explained below). 1969-- 1970-- @ 1971-- 'Data.Maybe.listToMaybe' '.' 'toList' ≡ 'preview' 'folded' 1972-- @ 1973-- 1974-- @ 1975-- 'preview' = 'view' '.' 'pre' 1976-- @ 1977-- 1978-- 1979-- Unlike '^?', this function uses a 1980-- 'Control.Monad.Reader.MonadReader' to read the value to be focused in on. 1981-- This allows one to pass the value as the last argument by using the 1982-- 'Control.Monad.Reader.MonadReader' instance for @(->) s@ 1983-- However, it may also be used as part of some deeply nested transformer stack. 1984-- 1985-- 'preview' uses a monoidal value to obtain the result. 1986-- This means that it generally has good performance, but can occasionally cause space leaks 1987-- or even stack overflows on some data types. 1988-- There is another function, 'firstOf', which avoids these issues at the cost of 1989-- a slight constant performance cost and a little less flexibility. 1990-- 1991-- It may be helpful to think of 'preview' as having one of the following 1992-- more specialized types: 1993-- 1994-- @ 1995-- 'preview' :: 'Getter' s a -> s -> 'Maybe' a 1996-- 'preview' :: 'Fold' s a -> s -> 'Maybe' a 1997-- 'preview' :: 'Lens'' s a -> s -> 'Maybe' a 1998-- 'preview' :: 'Iso'' s a -> s -> 'Maybe' a 1999-- 'preview' :: 'Traversal'' s a -> s -> 'Maybe' a 2000-- @ 2001-- 2002-- 2003-- @ 2004-- 'preview' :: 'MonadReader' s m => 'Getter' s a -> m ('Maybe' a) 2005-- 'preview' :: 'MonadReader' s m => 'Fold' s a -> m ('Maybe' a) 2006-- 'preview' :: 'MonadReader' s m => 'Lens'' s a -> m ('Maybe' a) 2007-- 'preview' :: 'MonadReader' s m => 'Iso'' s a -> m ('Maybe' a) 2008-- 'preview' :: 'MonadReader' s m => 'Traversal'' s a -> m ('Maybe' a) 2009-- 2010-- @ 2011preview :: MonadReader s m => Getting (First a) s a -> m (Maybe a) 2012preview l = asks (getFirst #. foldMapOf l (First #. Just)) 2013{-# INLINE preview #-} 2014 2015-- | Retrieve the first index and value targeted by a 'Fold' or 'Traversal' (or 'Just' the result 2016-- from a 'Getter' or 'Lens'). See also ('^@?'). 2017-- 2018-- @ 2019-- 'ipreview' = 'view' '.' 'ipre' 2020-- @ 2021-- 2022-- This is usually applied in the 'Control.Monad.Reader.Reader' 2023-- 'Control.Monad.Monad' @(->) s@. 2024-- 2025-- @ 2026-- 'ipreview' :: 'IndexedGetter' i s a -> s -> 'Maybe' (i, a) 2027-- 'ipreview' :: 'IndexedFold' i s a -> s -> 'Maybe' (i, a) 2028-- 'ipreview' :: 'IndexedLens'' i s a -> s -> 'Maybe' (i, a) 2029-- 'ipreview' :: 'IndexedTraversal'' i s a -> s -> 'Maybe' (i, a) 2030-- @ 2031-- 2032-- However, it may be useful to think of its full generality when working with 2033-- a 'Control.Monad.Monad' transformer stack: 2034-- 2035-- @ 2036-- 'ipreview' :: 'MonadReader' s m => 'IndexedGetter' s a -> m ('Maybe' (i, a)) 2037-- 'ipreview' :: 'MonadReader' s m => 'IndexedFold' s a -> m ('Maybe' (i, a)) 2038-- 'ipreview' :: 'MonadReader' s m => 'IndexedLens'' s a -> m ('Maybe' (i, a)) 2039-- 'ipreview' :: 'MonadReader' s m => 'IndexedTraversal'' s a -> m ('Maybe' (i, a)) 2040-- @ 2041ipreview :: MonadReader s m => IndexedGetting i (First (i, a)) s a -> m (Maybe (i, a)) 2042ipreview l = asks (getFirst #. ifoldMapOf l (\i a -> First (Just (i, a)))) 2043{-# INLINE ipreview #-} 2044 2045-- | Retrieve a function of the first value targeted by a 'Fold' or 2046-- 'Traversal' (or 'Just' the result from a 'Getter' or 'Lens'). 2047-- 2048-- This is usually applied in the 'Control.Monad.Reader.Reader' 2049-- 'Control.Monad.Monad' @(->) s@. 2050 2051-- @ 2052-- 'previews' = 'views' '.' 'pre' 2053-- @ 2054-- 2055-- @ 2056-- 'previews' :: 'Getter' s a -> (a -> r) -> s -> 'Maybe' r 2057-- 'previews' :: 'Fold' s a -> (a -> r) -> s -> 'Maybe' r 2058-- 'previews' :: 'Lens'' s a -> (a -> r) -> s -> 'Maybe' r 2059-- 'previews' :: 'Iso'' s a -> (a -> r) -> s -> 'Maybe' r 2060-- 'previews' :: 'Traversal'' s a -> (a -> r) -> s -> 'Maybe' r 2061-- @ 2062-- 2063-- However, it may be useful to think of its full generality when working with 2064-- a 'Monad' transformer stack: 2065-- 2066-- @ 2067-- 'previews' :: 'MonadReader' s m => 'Getter' s a -> (a -> r) -> m ('Maybe' r) 2068-- 'previews' :: 'MonadReader' s m => 'Fold' s a -> (a -> r) -> m ('Maybe' r) 2069-- 'previews' :: 'MonadReader' s m => 'Lens'' s a -> (a -> r) -> m ('Maybe' r) 2070-- 'previews' :: 'MonadReader' s m => 'Iso'' s a -> (a -> r) -> m ('Maybe' r) 2071-- 'previews' :: 'MonadReader' s m => 'Traversal'' s a -> (a -> r) -> m ('Maybe' r) 2072-- @ 2073previews :: MonadReader s m => Getting (First r) s a -> (a -> r) -> m (Maybe r) 2074previews l f = asks (getFirst . foldMapOf l (First #. Just . f)) 2075{-# INLINE previews #-} 2076 2077-- | Retrieve a function of the first index and value targeted by an 'IndexedFold' or 2078-- 'IndexedTraversal' (or 'Just' the result from an 'IndexedGetter' or 'IndexedLens'). 2079-- See also ('^@?'). 2080-- 2081-- @ 2082-- 'ipreviews' = 'views' '.' 'ipre' 2083-- @ 2084-- 2085-- This is usually applied in the 'Control.Monad.Reader.Reader' 2086-- 'Control.Monad.Monad' @(->) s@. 2087-- 2088-- @ 2089-- 'ipreviews' :: 'IndexedGetter' i s a -> (i -> a -> r) -> s -> 'Maybe' r 2090-- 'ipreviews' :: 'IndexedFold' i s a -> (i -> a -> r) -> s -> 'Maybe' r 2091-- 'ipreviews' :: 'IndexedLens'' i s a -> (i -> a -> r) -> s -> 'Maybe' r 2092-- 'ipreviews' :: 'IndexedTraversal'' i s a -> (i -> a -> r) -> s -> 'Maybe' r 2093-- @ 2094-- 2095-- However, it may be useful to think of its full generality when working with 2096-- a 'Control.Monad.Monad' transformer stack: 2097-- 2098-- @ 2099-- 'ipreviews' :: 'MonadReader' s m => 'IndexedGetter' i s a -> (i -> a -> r) -> m ('Maybe' r) 2100-- 'ipreviews' :: 'MonadReader' s m => 'IndexedFold' i s a -> (i -> a -> r) -> m ('Maybe' r) 2101-- 'ipreviews' :: 'MonadReader' s m => 'IndexedLens'' i s a -> (i -> a -> r) -> m ('Maybe' r) 2102-- 'ipreviews' :: 'MonadReader' s m => 'IndexedTraversal'' i s a -> (i -> a -> r) -> m ('Maybe' r) 2103-- @ 2104ipreviews :: MonadReader s m => IndexedGetting i (First r) s a -> (i -> a -> r) -> m (Maybe r) 2105ipreviews l f = asks (getFirst . ifoldMapOf l (\i -> First #. Just . f i)) 2106{-# INLINE ipreviews #-} 2107 2108------------------------------------------------------------------------------ 2109-- Preuse 2110------------------------------------------------------------------------------ 2111 2112-- | Retrieve the first value targeted by a 'Fold' or 'Traversal' (or 'Just' the result 2113-- from a 'Getter' or 'Lens') into the current state. 2114-- 2115-- @ 2116-- 'preuse' = 'use' '.' 'pre' 2117-- @ 2118-- 2119-- @ 2120-- 'preuse' :: 'MonadState' s m => 'Getter' s a -> m ('Maybe' a) 2121-- 'preuse' :: 'MonadState' s m => 'Fold' s a -> m ('Maybe' a) 2122-- 'preuse' :: 'MonadState' s m => 'Lens'' s a -> m ('Maybe' a) 2123-- 'preuse' :: 'MonadState' s m => 'Iso'' s a -> m ('Maybe' a) 2124-- 'preuse' :: 'MonadState' s m => 'Traversal'' s a -> m ('Maybe' a) 2125-- @ 2126preuse :: MonadState s m => Getting (First a) s a -> m (Maybe a) 2127preuse l = gets (preview l) 2128{-# INLINE preuse #-} 2129 2130-- | Retrieve the first index and value targeted by an 'IndexedFold' or 'IndexedTraversal' (or 'Just' the index 2131-- and result from an 'IndexedGetter' or 'IndexedLens') into the current state. 2132-- 2133-- @ 2134-- 'ipreuse' = 'use' '.' 'ipre' 2135-- @ 2136-- 2137-- @ 2138-- 'ipreuse' :: 'MonadState' s m => 'IndexedGetter' i s a -> m ('Maybe' (i, a)) 2139-- 'ipreuse' :: 'MonadState' s m => 'IndexedFold' i s a -> m ('Maybe' (i, a)) 2140-- 'ipreuse' :: 'MonadState' s m => 'IndexedLens'' i s a -> m ('Maybe' (i, a)) 2141-- 'ipreuse' :: 'MonadState' s m => 'IndexedTraversal'' i s a -> m ('Maybe' (i, a)) 2142-- @ 2143ipreuse :: MonadState s m => IndexedGetting i (First (i, a)) s a -> m (Maybe (i, a)) 2144ipreuse l = gets (ipreview l) 2145{-# INLINE ipreuse #-} 2146 2147-- | Retrieve a function of the first value targeted by a 'Fold' or 2148-- 'Traversal' (or 'Just' the result from a 'Getter' or 'Lens') into the current state. 2149-- 2150-- @ 2151-- 'preuses' = 'uses' '.' 'pre' 2152-- @ 2153-- 2154-- @ 2155-- 'preuses' :: 'MonadState' s m => 'Getter' s a -> (a -> r) -> m ('Maybe' r) 2156-- 'preuses' :: 'MonadState' s m => 'Fold' s a -> (a -> r) -> m ('Maybe' r) 2157-- 'preuses' :: 'MonadState' s m => 'Lens'' s a -> (a -> r) -> m ('Maybe' r) 2158-- 'preuses' :: 'MonadState' s m => 'Iso'' s a -> (a -> r) -> m ('Maybe' r) 2159-- 'preuses' :: 'MonadState' s m => 'Traversal'' s a -> (a -> r) -> m ('Maybe' r) 2160-- @ 2161preuses :: MonadState s m => Getting (First r) s a -> (a -> r) -> m (Maybe r) 2162preuses l f = gets (previews l f) 2163{-# INLINE preuses #-} 2164 2165-- | Retrieve a function of the first index and value targeted by an 'IndexedFold' or 2166-- 'IndexedTraversal' (or a function of 'Just' the index and result from an 'IndexedGetter' 2167-- or 'IndexedLens') into the current state. 2168-- 2169-- @ 2170-- 'ipreuses' = 'uses' '.' 'ipre' 2171-- @ 2172-- 2173-- @ 2174-- 'ipreuses' :: 'MonadState' s m => 'IndexedGetter' i s a -> (i -> a -> r) -> m ('Maybe' r) 2175-- 'ipreuses' :: 'MonadState' s m => 'IndexedFold' i s a -> (i -> a -> r) -> m ('Maybe' r) 2176-- 'ipreuses' :: 'MonadState' s m => 'IndexedLens'' i s a -> (i -> a -> r) -> m ('Maybe' r) 2177-- 'ipreuses' :: 'MonadState' s m => 'IndexedTraversal'' i s a -> (i -> a -> r) -> m ('Maybe' r) 2178-- @ 2179ipreuses :: MonadState s m => IndexedGetting i (First r) s a -> (i -> a -> r) -> m (Maybe r) 2180ipreuses l f = gets (ipreviews l f) 2181{-# INLINE ipreuses #-} 2182 2183------------------------------------------------------------------------------ 2184-- Profunctors 2185------------------------------------------------------------------------------ 2186 2187 2188-- | This allows you to 'Control.Traversable.traverse' the elements of a pretty much any 'LensLike' construction in the opposite order. 2189-- 2190-- This will preserve indexes on 'Indexed' types and will give you the elements of a (finite) 'Fold' or 'Traversal' in the opposite order. 2191-- 2192-- This has no practical impact on a 'Getter', 'Setter', 'Lens' or 'Iso'. 2193-- 2194-- /NB:/ To write back through an 'Iso', you want to use 'Control.Lens.Isomorphic.from'. 2195-- Similarly, to write back through an 'Prism', you want to use 'Control.Lens.Review.re'. 2196backwards :: (Profunctor p, Profunctor q) => Optical p q (Backwards f) s t a b -> Optical p q f s t a b 2197backwards l f = forwards #. l (Backwards #. f) 2198{-# INLINE backwards #-} 2199 2200------------------------------------------------------------------------------ 2201-- Indexed Folds 2202------------------------------------------------------------------------------ 2203 2204-- | Fold an 'IndexedFold' or 'IndexedTraversal' by mapping indices and values to an arbitrary 'Monoid' with access 2205-- to the @i@. 2206-- 2207-- When you don't need access to the index then 'foldMapOf' is more flexible in what it accepts. 2208-- 2209-- @ 2210-- 'foldMapOf' l ≡ 'ifoldMapOf' l '.' 'const' 2211-- @ 2212-- 2213-- @ 2214-- 'ifoldMapOf' :: 'IndexedGetter' i s a -> (i -> a -> m) -> s -> m 2215-- 'ifoldMapOf' :: 'Monoid' m => 'IndexedFold' i s a -> (i -> a -> m) -> s -> m 2216-- 'ifoldMapOf' :: 'IndexedLens'' i s a -> (i -> a -> m) -> s -> m 2217-- 'ifoldMapOf' :: 'Monoid' m => 'IndexedTraversal'' i s a -> (i -> a -> m) -> s -> m 2218-- @ 2219-- 2220ifoldMapOf :: IndexedGetting i m s a -> (i -> a -> m) -> s -> m 2221ifoldMapOf l f = getConst #. l (Const #. Indexed f) 2222{-# INLINE ifoldMapOf #-} 2223 2224-- | Right-associative fold of parts of a structure that are viewed through an 'IndexedFold' or 'IndexedTraversal' with 2225-- access to the @i@. 2226-- 2227-- When you don't need access to the index then 'foldrOf' is more flexible in what it accepts. 2228-- 2229-- @ 2230-- 'foldrOf' l ≡ 'ifoldrOf' l '.' 'const' 2231-- @ 2232-- 2233-- @ 2234-- 'ifoldrOf' :: 'IndexedGetter' i s a -> (i -> a -> r -> r) -> r -> s -> r 2235-- 'ifoldrOf' :: 'IndexedFold' i s a -> (i -> a -> r -> r) -> r -> s -> r 2236-- 'ifoldrOf' :: 'IndexedLens'' i s a -> (i -> a -> r -> r) -> r -> s -> r 2237-- 'ifoldrOf' :: 'IndexedTraversal'' i s a -> (i -> a -> r -> r) -> r -> s -> r 2238-- @ 2239ifoldrOf :: IndexedGetting i (Endo r) s a -> (i -> a -> r -> r) -> r -> s -> r 2240ifoldrOf l f z = flip appEndo z . getConst #. l (Const #. Endo #. Indexed f) 2241{-# INLINE ifoldrOf #-} 2242 2243-- | Left-associative fold of the parts of a structure that are viewed through an 'IndexedFold' or 'IndexedTraversal' with 2244-- access to the @i@. 2245-- 2246-- When you don't need access to the index then 'foldlOf' is more flexible in what it accepts. 2247-- 2248-- @ 2249-- 'foldlOf' l ≡ 'ifoldlOf' l '.' 'const' 2250-- @ 2251-- 2252-- @ 2253-- 'ifoldlOf' :: 'IndexedGetter' i s a -> (i -> r -> a -> r) -> r -> s -> r 2254-- 'ifoldlOf' :: 'IndexedFold' i s a -> (i -> r -> a -> r) -> r -> s -> r 2255-- 'ifoldlOf' :: 'IndexedLens'' i s a -> (i -> r -> a -> r) -> r -> s -> r 2256-- 'ifoldlOf' :: 'IndexedTraversal'' i s a -> (i -> r -> a -> r) -> r -> s -> r 2257-- @ 2258ifoldlOf :: IndexedGetting i (Dual (Endo r)) s a -> (i -> r -> a -> r) -> r -> s -> r 2259ifoldlOf l f z = (flip appEndo z .# getDual) `rmap` ifoldMapOf l (\i -> Dual #. Endo #. flip (f i)) 2260{-# INLINE ifoldlOf #-} 2261 2262-- | Return whether or not any element viewed through an 'IndexedFold' or 'IndexedTraversal' 2263-- satisfy a predicate, with access to the @i@. 2264-- 2265-- When you don't need access to the index then 'anyOf' is more flexible in what it accepts. 2266-- 2267-- @ 2268-- 'anyOf' l ≡ 'ianyOf' l '.' 'const' 2269-- @ 2270-- 2271-- @ 2272-- 'ianyOf' :: 'IndexedGetter' i s a -> (i -> a -> 'Bool') -> s -> 'Bool' 2273-- 'ianyOf' :: 'IndexedFold' i s a -> (i -> a -> 'Bool') -> s -> 'Bool' 2274-- 'ianyOf' :: 'IndexedLens'' i s a -> (i -> a -> 'Bool') -> s -> 'Bool' 2275-- 'ianyOf' :: 'IndexedTraversal'' i s a -> (i -> a -> 'Bool') -> s -> 'Bool' 2276-- @ 2277ianyOf :: IndexedGetting i Any s a -> (i -> a -> Bool) -> s -> Bool 2278ianyOf l f = getAny #. getConst #. l (Const #. Any #. Indexed f) 2279{-# INLINE ianyOf #-} 2280 2281-- | Return whether or not all elements viewed through an 'IndexedFold' or 'IndexedTraversal' 2282-- satisfy a predicate, with access to the @i@. 2283-- 2284-- When you don't need access to the index then 'allOf' is more flexible in what it accepts. 2285-- 2286-- @ 2287-- 'allOf' l ≡ 'iallOf' l '.' 'const' 2288-- @ 2289-- 2290-- @ 2291-- 'iallOf' :: 'IndexedGetter' i s a -> (i -> a -> 'Bool') -> s -> 'Bool' 2292-- 'iallOf' :: 'IndexedFold' i s a -> (i -> a -> 'Bool') -> s -> 'Bool' 2293-- 'iallOf' :: 'IndexedLens'' i s a -> (i -> a -> 'Bool') -> s -> 'Bool' 2294-- 'iallOf' :: 'IndexedTraversal'' i s a -> (i -> a -> 'Bool') -> s -> 'Bool' 2295-- @ 2296iallOf :: IndexedGetting i All s a -> (i -> a -> Bool) -> s -> Bool 2297iallOf l f = getAll #. getConst #. l (Const #. All #. Indexed f) 2298{-# INLINE iallOf #-} 2299 2300-- | Return whether or not none of the elements viewed through an 'IndexedFold' or 'IndexedTraversal' 2301-- satisfy a predicate, with access to the @i@. 2302-- 2303-- When you don't need access to the index then 'noneOf' is more flexible in what it accepts. 2304-- 2305-- @ 2306-- 'noneOf' l ≡ 'inoneOf' l '.' 'const' 2307-- @ 2308-- 2309-- @ 2310-- 'inoneOf' :: 'IndexedGetter' i s a -> (i -> a -> 'Bool') -> s -> 'Bool' 2311-- 'inoneOf' :: 'IndexedFold' i s a -> (i -> a -> 'Bool') -> s -> 'Bool' 2312-- 'inoneOf' :: 'IndexedLens'' i s a -> (i -> a -> 'Bool') -> s -> 'Bool' 2313-- 'inoneOf' :: 'IndexedTraversal'' i s a -> (i -> a -> 'Bool') -> s -> 'Bool' 2314-- @ 2315inoneOf :: IndexedGetting i Any s a -> (i -> a -> Bool) -> s -> Bool 2316inoneOf l f = not . ianyOf l f 2317{-# INLINE inoneOf #-} 2318 2319-- | Traverse the targets of an 'IndexedFold' or 'IndexedTraversal' with access to the @i@, discarding the results. 2320-- 2321-- When you don't need access to the index then 'traverseOf_' is more flexible in what it accepts. 2322-- 2323-- @ 2324-- 'traverseOf_' l ≡ 'Control.Lens.Traversal.itraverseOf' l '.' 'const' 2325-- @ 2326-- 2327-- @ 2328-- 'itraverseOf_' :: 'Functor' f => 'IndexedGetter' i s a -> (i -> a -> f r) -> s -> f () 2329-- 'itraverseOf_' :: 'Applicative' f => 'IndexedFold' i s a -> (i -> a -> f r) -> s -> f () 2330-- 'itraverseOf_' :: 'Functor' f => 'IndexedLens'' i s a -> (i -> a -> f r) -> s -> f () 2331-- 'itraverseOf_' :: 'Applicative' f => 'IndexedTraversal'' i s a -> (i -> a -> f r) -> s -> f () 2332-- @ 2333itraverseOf_ :: Functor f => IndexedGetting i (Traversed r f) s a -> (i -> a -> f r) -> s -> f () 2334itraverseOf_ l f = void . getTraversed #. getConst #. l (Const #. Traversed #. Indexed f) 2335{-# INLINE itraverseOf_ #-} 2336 2337-- | Traverse the targets of an 'IndexedFold' or 'IndexedTraversal' with access to the index, discarding the results 2338-- (with the arguments flipped). 2339-- 2340-- @ 2341-- 'iforOf_' ≡ 'flip' '.' 'itraverseOf_' 2342-- @ 2343-- 2344-- When you don't need access to the index then 'forOf_' is more flexible in what it accepts. 2345-- 2346-- @ 2347-- 'forOf_' l a ≡ 'iforOf_' l a '.' 'const' 2348-- @ 2349-- 2350-- @ 2351-- 'iforOf_' :: 'Functor' f => 'IndexedGetter' i s a -> s -> (i -> a -> f r) -> f () 2352-- 'iforOf_' :: 'Applicative' f => 'IndexedFold' i s a -> s -> (i -> a -> f r) -> f () 2353-- 'iforOf_' :: 'Functor' f => 'IndexedLens'' i s a -> s -> (i -> a -> f r) -> f () 2354-- 'iforOf_' :: 'Applicative' f => 'IndexedTraversal'' i s a -> s -> (i -> a -> f r) -> f () 2355-- @ 2356iforOf_ :: Functor f => IndexedGetting i (Traversed r f) s a -> s -> (i -> a -> f r) -> f () 2357iforOf_ = flip . itraverseOf_ 2358{-# INLINE iforOf_ #-} 2359 2360-- | Run monadic actions for each target of an 'IndexedFold' or 'IndexedTraversal' with access to the index, 2361-- discarding the results. 2362-- 2363-- When you don't need access to the index then 'mapMOf_' is more flexible in what it accepts. 2364-- 2365-- @ 2366-- 'mapMOf_' l ≡ 'Control.Lens.Setter.imapMOf' l '.' 'const' 2367-- @ 2368-- 2369-- @ 2370-- 'imapMOf_' :: 'Monad' m => 'IndexedGetter' i s a -> (i -> a -> m r) -> s -> m () 2371-- 'imapMOf_' :: 'Monad' m => 'IndexedFold' i s a -> (i -> a -> m r) -> s -> m () 2372-- 'imapMOf_' :: 'Monad' m => 'IndexedLens'' i s a -> (i -> a -> m r) -> s -> m () 2373-- 'imapMOf_' :: 'Monad' m => 'IndexedTraversal'' i s a -> (i -> a -> m r) -> s -> m () 2374-- @ 2375imapMOf_ :: Monad m => IndexedGetting i (Sequenced r m) s a -> (i -> a -> m r) -> s -> m () 2376imapMOf_ l f = liftM skip . getSequenced #. getConst #. l (Const #. Sequenced #. Indexed f) 2377{-# INLINE imapMOf_ #-} 2378 2379-- | Run monadic actions for each target of an 'IndexedFold' or 'IndexedTraversal' with access to the index, 2380-- discarding the results (with the arguments flipped). 2381-- 2382-- @ 2383-- 'iforMOf_' ≡ 'flip' '.' 'imapMOf_' 2384-- @ 2385-- 2386-- When you don't need access to the index then 'forMOf_' is more flexible in what it accepts. 2387-- 2388-- @ 2389-- 'forMOf_' l a ≡ 'Control.Lens.Traversal.iforMOf' l a '.' 'const' 2390-- @ 2391-- 2392-- @ 2393-- 'iforMOf_' :: 'Monad' m => 'IndexedGetter' i s a -> s -> (i -> a -> m r) -> m () 2394-- 'iforMOf_' :: 'Monad' m => 'IndexedFold' i s a -> s -> (i -> a -> m r) -> m () 2395-- 'iforMOf_' :: 'Monad' m => 'IndexedLens'' i s a -> s -> (i -> a -> m r) -> m () 2396-- 'iforMOf_' :: 'Monad' m => 'IndexedTraversal'' i s a -> s -> (i -> a -> m r) -> m () 2397-- @ 2398iforMOf_ :: Monad m => IndexedGetting i (Sequenced r m) s a -> s -> (i -> a -> m r) -> m () 2399iforMOf_ = flip . imapMOf_ 2400{-# INLINE iforMOf_ #-} 2401 2402-- | Concatenate the results of a function of the elements of an 'IndexedFold' or 'IndexedTraversal' 2403-- with access to the index. 2404-- 2405-- When you don't need access to the index then 'concatMapOf' is more flexible in what it accepts. 2406-- 2407-- @ 2408-- 'concatMapOf' l ≡ 'iconcatMapOf' l '.' 'const' 2409-- 'iconcatMapOf' ≡ 'ifoldMapOf' 2410-- @ 2411-- 2412-- @ 2413-- 'iconcatMapOf' :: 'IndexedGetter' i s a -> (i -> a -> [r]) -> s -> [r] 2414-- 'iconcatMapOf' :: 'IndexedFold' i s a -> (i -> a -> [r]) -> s -> [r] 2415-- 'iconcatMapOf' :: 'IndexedLens'' i s a -> (i -> a -> [r]) -> s -> [r] 2416-- 'iconcatMapOf' :: 'IndexedTraversal'' i s a -> (i -> a -> [r]) -> s -> [r] 2417-- @ 2418iconcatMapOf :: IndexedGetting i [r] s a -> (i -> a -> [r]) -> s -> [r] 2419iconcatMapOf = ifoldMapOf 2420{-# INLINE iconcatMapOf #-} 2421 2422-- | The 'ifindOf' function takes an 'IndexedFold' or 'IndexedTraversal', a predicate that is also 2423-- supplied the index, a structure and returns the left-most element of the structure 2424-- matching the predicate, or 'Nothing' if there is no such element. 2425-- 2426-- When you don't need access to the index then 'findOf' is more flexible in what it accepts. 2427-- 2428-- @ 2429-- 'findOf' l ≡ 'ifindOf' l '.' 'const' 2430-- @ 2431-- 2432-- @ 2433-- 'ifindOf' :: 'IndexedGetter' i s a -> (i -> a -> 'Bool') -> s -> 'Maybe' a 2434-- 'ifindOf' :: 'IndexedFold' i s a -> (i -> a -> 'Bool') -> s -> 'Maybe' a 2435-- 'ifindOf' :: 'IndexedLens'' i s a -> (i -> a -> 'Bool') -> s -> 'Maybe' a 2436-- 'ifindOf' :: 'IndexedTraversal'' i s a -> (i -> a -> 'Bool') -> s -> 'Maybe' a 2437-- @ 2438ifindOf :: IndexedGetting i (Endo (Maybe a)) s a -> (i -> a -> Bool) -> s -> Maybe a 2439ifindOf l f = ifoldrOf l (\i a y -> if f i a then Just a else y) Nothing 2440{-# INLINE ifindOf #-} 2441 2442-- | The 'ifindMOf' function takes an 'IndexedFold' or 'IndexedTraversal', a monadic predicate that is also 2443-- supplied the index, a structure and returns in the monad the left-most element of the structure 2444-- matching the predicate, or 'Nothing' if there is no such element. 2445-- 2446-- When you don't need access to the index then 'findMOf' is more flexible in what it accepts. 2447-- 2448-- @ 2449-- 'findMOf' l ≡ 'ifindMOf' l '.' 'const' 2450-- @ 2451-- 2452-- @ 2453-- 'ifindMOf' :: 'Monad' m => 'IndexedGetter' i s a -> (i -> a -> m 'Bool') -> s -> m ('Maybe' a) 2454-- 'ifindMOf' :: 'Monad' m => 'IndexedFold' i s a -> (i -> a -> m 'Bool') -> s -> m ('Maybe' a) 2455-- 'ifindMOf' :: 'Monad' m => 'IndexedLens'' i s a -> (i -> a -> m 'Bool') -> s -> m ('Maybe' a) 2456-- 'ifindMOf' :: 'Monad' m => 'IndexedTraversal'' i s a -> (i -> a -> m 'Bool') -> s -> m ('Maybe' a) 2457-- @ 2458ifindMOf :: Monad m => IndexedGetting i (Endo (m (Maybe a))) s a -> (i -> a -> m Bool) -> s -> m (Maybe a) 2459ifindMOf l f = ifoldrOf l (\i a y -> f i a >>= \r -> if r then return (Just a) else y) $ return Nothing 2460{-# INLINE ifindMOf #-} 2461 2462-- | /Strictly/ fold right over the elements of a structure with an index. 2463-- 2464-- When you don't need access to the index then 'foldrOf'' is more flexible in what it accepts. 2465-- 2466-- @ 2467-- 'foldrOf'' l ≡ 'ifoldrOf'' l '.' 'const' 2468-- @ 2469-- 2470-- @ 2471-- 'ifoldrOf'' :: 'IndexedGetter' i s a -> (i -> a -> r -> r) -> r -> s -> r 2472-- 'ifoldrOf'' :: 'IndexedFold' i s a -> (i -> a -> r -> r) -> r -> s -> r 2473-- 'ifoldrOf'' :: 'IndexedLens'' i s a -> (i -> a -> r -> r) -> r -> s -> r 2474-- 'ifoldrOf'' :: 'IndexedTraversal'' i s a -> (i -> a -> r -> r) -> r -> s -> r 2475-- @ 2476ifoldrOf' :: IndexedGetting i (Dual (Endo (r -> r))) s a -> (i -> a -> r -> r) -> r -> s -> r 2477ifoldrOf' l f z0 xs = ifoldlOf l f' id xs z0 2478 where f' i k x z = k $! f i x z 2479{-# INLINE ifoldrOf' #-} 2480 2481-- | Fold over the elements of a structure with an index, associating to the left, but /strictly/. 2482-- 2483-- When you don't need access to the index then 'foldlOf'' is more flexible in what it accepts. 2484-- 2485-- @ 2486-- 'foldlOf'' l ≡ 'ifoldlOf'' l '.' 'const' 2487-- @ 2488-- 2489-- @ 2490-- 'ifoldlOf'' :: 'IndexedGetter' i s a -> (i -> r -> a -> r) -> r -> s -> r 2491-- 'ifoldlOf'' :: 'IndexedFold' i s a -> (i -> r -> a -> r) -> r -> s -> r 2492-- 'ifoldlOf'' :: 'IndexedLens'' i s a -> (i -> r -> a -> r) -> r -> s -> r 2493-- 'ifoldlOf'' :: 'IndexedTraversal'' i s a -> (i -> r -> a -> r) -> r -> s -> r 2494-- @ 2495ifoldlOf' :: IndexedGetting i (Endo (r -> r)) s a -> (i -> r -> a -> r) -> r -> s -> r 2496ifoldlOf' l f z0 xs = ifoldrOf l f' id xs z0 2497 where f' i x k z = k $! f i z x 2498{-# INLINE ifoldlOf' #-} 2499 2500-- | Monadic fold right over the elements of a structure with an index. 2501-- 2502-- When you don't need access to the index then 'foldrMOf' is more flexible in what it accepts. 2503-- 2504-- @ 2505-- 'foldrMOf' l ≡ 'ifoldrMOf' l '.' 'const' 2506-- @ 2507-- 2508-- @ 2509-- 'ifoldrMOf' :: 'Monad' m => 'IndexedGetter' i s a -> (i -> a -> r -> m r) -> r -> s -> m r 2510-- 'ifoldrMOf' :: 'Monad' m => 'IndexedFold' i s a -> (i -> a -> r -> m r) -> r -> s -> m r 2511-- 'ifoldrMOf' :: 'Monad' m => 'IndexedLens'' i s a -> (i -> a -> r -> m r) -> r -> s -> m r 2512-- 'ifoldrMOf' :: 'Monad' m => 'IndexedTraversal'' i s a -> (i -> a -> r -> m r) -> r -> s -> m r 2513-- @ 2514ifoldrMOf :: Monad m => IndexedGetting i (Dual (Endo (r -> m r))) s a -> (i -> a -> r -> m r) -> r -> s -> m r 2515ifoldrMOf l f z0 xs = ifoldlOf l f' return xs z0 2516 where f' i k x z = f i x z >>= k 2517{-# INLINE ifoldrMOf #-} 2518 2519-- | Monadic fold over the elements of a structure with an index, associating to the left. 2520-- 2521-- When you don't need access to the index then 'foldlMOf' is more flexible in what it accepts. 2522-- 2523-- @ 2524-- 'foldlMOf' l ≡ 'ifoldlMOf' l '.' 'const' 2525-- @ 2526-- 2527-- @ 2528-- 'ifoldlMOf' :: 'Monad' m => 'IndexedGetter' i s a -> (i -> r -> a -> m r) -> r -> s -> m r 2529-- 'ifoldlMOf' :: 'Monad' m => 'IndexedFold' i s a -> (i -> r -> a -> m r) -> r -> s -> m r 2530-- 'ifoldlMOf' :: 'Monad' m => 'IndexedLens'' i s a -> (i -> r -> a -> m r) -> r -> s -> m r 2531-- 'ifoldlMOf' :: 'Monad' m => 'IndexedTraversal'' i s a -> (i -> r -> a -> m r) -> r -> s -> m r 2532-- @ 2533ifoldlMOf :: Monad m => IndexedGetting i (Endo (r -> m r)) s a -> (i -> r -> a -> m r) -> r -> s -> m r 2534ifoldlMOf l f z0 xs = ifoldrOf l f' return xs z0 2535 where f' i x k z = f i z x >>= k 2536{-# INLINE ifoldlMOf #-} 2537 2538-- | Extract the key-value pairs from a structure. 2539-- 2540-- When you don't need access to the indices in the result, then 'toListOf' is more flexible in what it accepts. 2541-- 2542-- @ 2543-- 'toListOf' l ≡ 'map' 'snd' '.' 'itoListOf' l 2544-- @ 2545-- 2546-- @ 2547-- 'itoListOf' :: 'IndexedGetter' i s a -> s -> [(i,a)] 2548-- 'itoListOf' :: 'IndexedFold' i s a -> s -> [(i,a)] 2549-- 'itoListOf' :: 'IndexedLens'' i s a -> s -> [(i,a)] 2550-- 'itoListOf' :: 'IndexedTraversal'' i s a -> s -> [(i,a)] 2551-- @ 2552itoListOf :: IndexedGetting i (Endo [(i,a)]) s a -> s -> [(i,a)] 2553itoListOf l = ifoldrOf l (\i a -> ((i,a):)) [] 2554{-# INLINE itoListOf #-} 2555 2556-- | An infix version of 'itoListOf'. 2557 2558-- @ 2559-- ('^@..') :: s -> 'IndexedGetter' i s a -> [(i,a)] 2560-- ('^@..') :: s -> 'IndexedFold' i s a -> [(i,a)] 2561-- ('^@..') :: s -> 'IndexedLens'' i s a -> [(i,a)] 2562-- ('^@..') :: s -> 'IndexedTraversal'' i s a -> [(i,a)] 2563-- @ 2564(^@..) :: s -> IndexedGetting i (Endo [(i,a)]) s a -> [(i,a)] 2565s ^@.. l = ifoldrOf l (\i a -> ((i,a):)) [] s 2566{-# INLINE (^@..) #-} 2567 2568-- | Perform a safe 'head' (with index) of an 'IndexedFold' or 'IndexedTraversal' or retrieve 'Just' the index and result 2569-- from an 'IndexedGetter' or 'IndexedLens'. 2570-- 2571-- When using a 'IndexedTraversal' as a partial 'IndexedLens', or an 'IndexedFold' as a partial 'IndexedGetter' this can be a convenient 2572-- way to extract the optional value. 2573-- 2574-- @ 2575-- ('^@?') :: s -> 'IndexedGetter' i s a -> 'Maybe' (i, a) 2576-- ('^@?') :: s -> 'IndexedFold' i s a -> 'Maybe' (i, a) 2577-- ('^@?') :: s -> 'IndexedLens'' i s a -> 'Maybe' (i, a) 2578-- ('^@?') :: s -> 'IndexedTraversal'' i s a -> 'Maybe' (i, a) 2579-- @ 2580(^@?) :: s -> IndexedGetting i (Endo (Maybe (i, a))) s a -> Maybe (i, a) 2581s ^@? l = ifoldrOf l (\i x _ -> Just (i,x)) Nothing s 2582{-# INLINE (^@?) #-} 2583 2584-- | Perform an *UNSAFE* 'head' (with index) of an 'IndexedFold' or 'IndexedTraversal' assuming that it is there. 2585-- 2586-- @ 2587-- ('^@?!') :: s -> 'IndexedGetter' i s a -> (i, a) 2588-- ('^@?!') :: s -> 'IndexedFold' i s a -> (i, a) 2589-- ('^@?!') :: s -> 'IndexedLens'' i s a -> (i, a) 2590-- ('^@?!') :: s -> 'IndexedTraversal'' i s a -> (i, a) 2591-- @ 2592(^@?!) :: HasCallStack => s -> IndexedGetting i (Endo (i, a)) s a -> (i, a) 2593s ^@?! l = ifoldrOf l (\i x _ -> (i,x)) (error "(^@?!): empty Fold") s 2594{-# INLINE (^@?!) #-} 2595 2596-- | Retrieve the index of the first value targeted by a 'IndexedFold' or 'IndexedTraversal' which is equal to a given value. 2597-- 2598-- @ 2599-- 'Data.List.elemIndex' ≡ 'elemIndexOf' 'folded' 2600-- @ 2601-- 2602-- @ 2603-- 'elemIndexOf' :: 'Eq' a => 'IndexedFold' i s a -> a -> s -> 'Maybe' i 2604-- 'elemIndexOf' :: 'Eq' a => 'IndexedTraversal'' i s a -> a -> s -> 'Maybe' i 2605-- @ 2606elemIndexOf :: Eq a => IndexedGetting i (First i) s a -> a -> s -> Maybe i 2607elemIndexOf l a = findIndexOf l (a ==) 2608{-# INLINE elemIndexOf #-} 2609 2610-- | Retrieve the indices of the values targeted by a 'IndexedFold' or 'IndexedTraversal' which are equal to a given value. 2611-- 2612-- @ 2613-- 'Data.List.elemIndices' ≡ 'elemIndicesOf' 'folded' 2614-- @ 2615-- 2616-- @ 2617-- 'elemIndicesOf' :: 'Eq' a => 'IndexedFold' i s a -> a -> s -> [i] 2618-- 'elemIndicesOf' :: 'Eq' a => 'IndexedTraversal'' i s a -> a -> s -> [i] 2619-- @ 2620elemIndicesOf :: Eq a => IndexedGetting i (Endo [i]) s a -> a -> s -> [i] 2621elemIndicesOf l a = findIndicesOf l (a ==) 2622{-# INLINE elemIndicesOf #-} 2623 2624-- | Retrieve the index of the first value targeted by a 'IndexedFold' or 'IndexedTraversal' which satisfies a predicate. 2625-- 2626-- @ 2627-- 'Data.List.findIndex' ≡ 'findIndexOf' 'folded' 2628-- @ 2629-- 2630-- @ 2631-- 'findIndexOf' :: 'IndexedFold' i s a -> (a -> 'Bool') -> s -> 'Maybe' i 2632-- 'findIndexOf' :: 'IndexedTraversal'' i s a -> (a -> 'Bool') -> s -> 'Maybe' i 2633-- @ 2634findIndexOf :: IndexedGetting i (First i) s a -> (a -> Bool) -> s -> Maybe i 2635findIndexOf l p = preview (l . filtered p . asIndex) 2636{-# INLINE findIndexOf #-} 2637 2638-- | Retrieve the indices of the values targeted by a 'IndexedFold' or 'IndexedTraversal' which satisfy a predicate. 2639-- 2640-- @ 2641-- 'Data.List.findIndices' ≡ 'findIndicesOf' 'folded' 2642-- @ 2643-- 2644-- @ 2645-- 'findIndicesOf' :: 'IndexedFold' i s a -> (a -> 'Bool') -> s -> [i] 2646-- 'findIndicesOf' :: 'IndexedTraversal'' i s a -> (a -> 'Bool') -> s -> [i] 2647-- @ 2648findIndicesOf :: IndexedGetting i (Endo [i]) s a -> (a -> Bool) -> s -> [i] 2649findIndicesOf l p = toListOf (l . filtered p . asIndex) 2650{-# INLINE findIndicesOf #-} 2651 2652------------------------------------------------------------------------------- 2653-- Converting to Folds 2654------------------------------------------------------------------------------- 2655 2656-- | Filter an 'IndexedFold' or 'IndexedGetter', obtaining an 'IndexedFold'. 2657-- 2658-- >>> [0,0,0,5,5,5]^..traversed.ifiltered (\i a -> i <= a) 2659-- [0,5,5,5] 2660-- 2661-- Compose with 'ifiltered' to filter another 'IndexedLens', 'IndexedIso', 'IndexedGetter', 'IndexedFold' (or 'IndexedTraversal') with 2662-- access to both the value and the index. 2663-- 2664-- Note: As with 'filtered', this is /not/ a legal 'IndexedTraversal', unless you are very careful not to invalidate the predicate on the target! 2665ifiltered :: (Indexable i p, Applicative f) => (i -> a -> Bool) -> Optical' p (Indexed i) f a a 2666ifiltered p f = Indexed $ \i a -> if p i a then indexed f i a else pure a 2667{-# INLINE ifiltered #-} 2668 2669-- | Obtain an 'IndexedFold' by taking elements from another 2670-- 'IndexedFold', 'IndexedLens', 'IndexedGetter' or 'IndexedTraversal' while a predicate holds. 2671-- 2672-- @ 2673-- 'itakingWhile' :: (i -> a -> 'Bool') -> 'IndexedFold' i s a -> 'IndexedFold' i s a 2674-- 'itakingWhile' :: (i -> a -> 'Bool') -> 'IndexedTraversal'' i s a -> 'IndexedFold' i s a 2675-- 'itakingWhile' :: (i -> a -> 'Bool') -> 'IndexedLens'' i s a -> 'IndexedFold' i s a 2676-- 'itakingWhile' :: (i -> a -> 'Bool') -> 'IndexedGetter' i s a -> 'IndexedFold' i s a 2677-- @ 2678-- 2679-- Note: Applying 'itakingWhile' to an 'IndexedLens' or 'IndexedTraversal' will still allow you to use it as a 2680-- pseudo-'IndexedTraversal', but if you change the value of any target to one where the predicate returns 2681-- 'False', then you will break the 'Traversal' laws and 'Traversal' fusion will no longer be sound. 2682itakingWhile :: (Indexable i p, Profunctor q, Contravariant f, Applicative f) 2683 => (i -> a -> Bool) 2684 -> Optical' (Indexed i) q (Const (Endo (f s))) s a 2685 -> Optical' p q f s a 2686itakingWhile p l f = (flip appEndo noEffect .# getConst) `rmap` l g where 2687 g = Indexed $ \i a -> Const . Endo $ if p i a then (indexed f i a *>) else const noEffect 2688{-# INLINE itakingWhile #-} 2689 2690-- | Obtain an 'IndexedFold' by dropping elements from another 'IndexedFold', 'IndexedLens', 'IndexedGetter' or 'IndexedTraversal' while a predicate holds. 2691-- 2692-- @ 2693-- 'idroppingWhile' :: (i -> a -> 'Bool') -> 'IndexedFold' i s a -> 'IndexedFold' i s a 2694-- 'idroppingWhile' :: (i -> a -> 'Bool') -> 'IndexedTraversal'' i s a -> 'IndexedFold' i s a -- see notes 2695-- 'idroppingWhile' :: (i -> a -> 'Bool') -> 'IndexedLens'' i s a -> 'IndexedFold' i s a -- see notes 2696-- 'idroppingWhile' :: (i -> a -> 'Bool') -> 'IndexedGetter' i s a -> 'IndexedFold' i s a 2697-- @ 2698-- 2699-- Note: As with `droppingWhile` applying 'idroppingWhile' to an 'IndexedLens' or 'IndexedTraversal' will still 2700-- allow you to use it as a pseudo-'IndexedTraversal', but if you change the value of the first target to one 2701-- where the predicate returns 'True', then you will break the 'Traversal' laws and 'Traversal' fusion will 2702-- no longer be sound. 2703idroppingWhile :: (Indexable i p, Profunctor q, Applicative f) 2704 => (i -> a -> Bool) 2705 -> Optical (Indexed i) q (Compose (State Bool) f) s t a a 2706 -> Optical p q f s t a a 2707idroppingWhile p l f = (flip evalState True .# getCompose) `rmap` l g where 2708 g = Indexed $ \ i a -> Compose $ state $ \b -> let 2709 b' = b && p i a 2710 in (if b' then pure a else indexed f i a, b') 2711{-# INLINE idroppingWhile #-} 2712 2713------------------------------------------------------------------------------ 2714-- Misc. 2715------------------------------------------------------------------------------ 2716 2717skip :: a -> () 2718skip _ = () 2719{-# INLINE skip #-} 2720 2721------------------------------------------------------------------------------ 2722-- Folds with Reified Monoid 2723------------------------------------------------------------------------------ 2724 2725-- | Fold a value using a specified 'Fold' and 'Monoid' operations. 2726-- This is like 'foldBy' where the 'Foldable' instance can be 2727-- manually specified. 2728-- 2729-- @ 2730-- 'foldByOf' 'folded' ≡ 'foldBy' 2731-- @ 2732-- 2733-- @ 2734-- 'foldByOf' :: 'Getter' s a -> (a -> a -> a) -> a -> s -> a 2735-- 'foldByOf' :: 'Fold' s a -> (a -> a -> a) -> a -> s -> a 2736-- 'foldByOf' :: 'Lens'' s a -> (a -> a -> a) -> a -> s -> a 2737-- 'foldByOf' :: 'Traversal'' s a -> (a -> a -> a) -> a -> s -> a 2738-- 'foldByOf' :: 'Iso'' s a -> (a -> a -> a) -> a -> s -> a 2739-- @ 2740-- 2741-- >>> foldByOf both (++) [] ("hello","world") 2742-- "helloworld" 2743foldByOf :: Fold s a -> (a -> a -> a) -> a -> s -> a 2744foldByOf l f z = reifyMonoid f z (foldMapOf l ReflectedMonoid) 2745 2746-- | Fold a value using a specified 'Fold' and 'Monoid' operations. 2747-- This is like 'foldMapBy' where the 'Foldable' instance can be 2748-- manually specified. 2749-- 2750-- @ 2751-- 'foldMapByOf' 'folded' ≡ 'foldMapBy' 2752-- @ 2753-- 2754-- @ 2755-- 'foldMapByOf' :: 'Getter' s a -> (r -> r -> r) -> r -> (a -> r) -> s -> r 2756-- 'foldMapByOf' :: 'Fold' s a -> (r -> r -> r) -> r -> (a -> r) -> s -> r 2757-- 'foldMapByOf' :: 'Traversal'' s a -> (r -> r -> r) -> r -> (a -> r) -> s -> r 2758-- 'foldMapByOf' :: 'Lens'' s a -> (r -> r -> r) -> r -> (a -> r) -> s -> r 2759-- 'foldMapByOf' :: 'Iso'' s a -> (r -> r -> r) -> r -> (a -> r) -> s -> r 2760-- @ 2761-- 2762-- >>> foldMapByOf both (+) 0 length ("hello","world") 2763-- 10 2764foldMapByOf :: Fold s a -> (r -> r -> r) -> r -> (a -> r) -> s -> r 2765foldMapByOf l f z g = reifyMonoid f z (foldMapOf l (ReflectedMonoid #. g)) 2766