1{-# LANGUAGE CPP #-} 2{-# LANGUAGE Rank2Types #-} 3{-# LANGUAGE MultiParamTypeClasses #-} 4{-# LANGUAGE FlexibleInstances #-} 5{-# LANGUAGE FlexibleContexts #-} 6{-# LANGUAGE Trustworthy #-} 7 8----------------------------------------------------------------------------- 9-- | 10-- Module : Control.Lens.Setter 11-- Copyright : (C) 2012-16 Edward Kmett 12-- License : BSD-style (see the file LICENSE) 13-- Maintainer : Edward Kmett <ekmett@gmail.com> 14-- Stability : provisional 15-- Portability : Rank2Types 16-- 17-- A @'Setter' s t a b@ is a generalization of 'fmap' from 'Functor'. It allows you to map into a 18-- structure and change out the contents, but it isn't strong enough to allow you to 19-- enumerate those contents. Starting with @'fmap' :: 'Functor' f => (a -> b) -> f a -> f b@ 20-- we monomorphize the type to obtain @(a -> b) -> s -> t@ and then decorate it with 'Data.Functor.Identity.Identity' to obtain: 21-- 22-- @ 23-- type 'Setter' s t a b = (a -> 'Data.Functor.Identity.Identity' b) -> s -> 'Data.Functor.Identity.Identity' t 24-- @ 25-- 26-- Every 'Traversal' is a valid 'Setter', since 'Data.Functor.Identity.Identity' is 'Applicative'. 27-- 28-- Everything you can do with a 'Functor', you can do with a 'Setter'. There 29-- are combinators that generalize 'fmap' and ('<$'). 30---------------------------------------------------------------------------- 31module Control.Lens.Setter 32 ( 33 -- * Setters 34 Setter, Setter' 35 , IndexedSetter, IndexedSetter' 36 , ASetter, ASetter' 37 , AnIndexedSetter, AnIndexedSetter' 38 , Setting, Setting' 39 -- * Building Setters 40 , sets, setting 41 , cloneSetter 42 , cloneIndexPreservingSetter 43 , cloneIndexedSetter 44 -- * Common Setters 45 , mapped, lifted 46 , contramapped 47 , argument 48 -- * Functional Combinators 49 , over 50 , set 51 , (.~), (%~) 52 , (+~), (-~), (*~), (//~), (^~), (^^~), (**~), (||~), (<>~), (&&~), (<.~), (?~), (<?~) 53 -- * State Combinators 54 , assign, modifying 55 , (.=), (%=) 56 , (+=), (-=), (*=), (//=), (^=), (^^=), (**=), (||=), (<>=), (&&=), (<.=), (?=), (<?=) 57 , (<~) 58 -- * Writer Combinators 59 , scribe 60 , passing, ipassing 61 , censoring, icensoring 62 -- * Reader Combinators 63 , locally, ilocally 64 -- * Simplified State Setting 65 , set' 66 -- * Indexed Setters 67 , imapOf, iover, iset, imodifying 68 , isets 69 , (%@~), (.@~), (%@=), (.@=) 70 -- * Arrow operators 71 , assignA 72 -- * Exported for legible error messages 73 , Settable 74 , Identity(..) 75 -- * Deprecated 76 , mapOf 77 ) where 78 79import Prelude () 80 81import Control.Arrow 82import Control.Comonad 83import Control.Lens.Internal.Prelude 84import Control.Lens.Internal.Indexed 85import Control.Lens.Internal.Setter 86import Control.Lens.Type 87import Control.Monad (liftM) 88import Control.Monad.Reader.Class as Reader 89import Control.Monad.State.Class as State 90import Control.Monad.Writer.Class as Writer 91 92#ifdef HLINT 93{-# ANN module "HLint: ignore Avoid lambda" #-} 94{-# ANN module "HLint: ignore Use fmap" #-} 95#endif 96 97-- $setup 98-- >>> import Control.Lens 99-- >>> import Control.Monad.State 100-- >>> import Data.Char 101-- >>> import Data.Functor.Contravariant (Predicate (..), Op (..)) 102-- >>> import Data.Map as Map 103-- >>> import Data.Semigroup (Sum (..), Product (..)) 104-- >>> import Debug.SimpleReflect.Expr as Expr 105-- >>> import Debug.SimpleReflect.Vars as Vars 106-- >>> let f :: Expr -> Expr; f = Debug.SimpleReflect.Vars.f 107-- >>> let g :: Expr -> Expr; g = Debug.SimpleReflect.Vars.g 108-- >>> let h :: Expr -> Expr -> Expr; h = Debug.SimpleReflect.Vars.h 109-- >>> let getter :: Expr -> Expr; getter = fun "getter" 110-- >>> let setter :: Expr -> Expr -> Expr; setter = fun "setter" 111-- >>> :set -XNoOverloadedStrings 112 113infixr 4 %@~, .@~, .~, +~, *~, -~, //~, ^~, ^^~, **~, &&~, <>~, ||~, %~, <.~, ?~, <?~ 114infix 4 %@=, .@=, .=, +=, *=, -=, //=, ^=, ^^=, **=, &&=, <>=, ||=, %=, <.=, ?=, <?= 115infixr 2 <~ 116 117------------------------------------------------------------------------------ 118-- Setters 119------------------------------------------------------------------------------ 120 121-- | Running a 'Setter' instantiates it to a concrete type. 122-- 123-- When consuming a setter directly to perform a mapping, you can use this type, but most 124-- user code will not need to use this type. 125type ASetter s t a b = (a -> Identity b) -> s -> Identity t 126 127-- | This is a useful alias for use when consuming a 'Setter''. 128-- 129-- Most user code will never have to use this type. 130-- 131-- @ 132-- type 'ASetter'' = 'Simple' 'ASetter' 133-- @ 134type ASetter' s a = ASetter s s a a 135 136-- | Running an 'IndexedSetter' instantiates it to a concrete type. 137-- 138-- When consuming a setter directly to perform a mapping, you can use this type, but most 139-- user code will not need to use this type. 140type AnIndexedSetter i s t a b = Indexed i a (Identity b) -> s -> Identity t 141 142-- | @ 143-- type 'AnIndexedSetter'' i = 'Simple' ('AnIndexedSetter' i) 144-- @ 145type AnIndexedSetter' i s a = AnIndexedSetter i s s a a 146 147-- | This is a convenient alias when defining highly polymorphic code that takes both 148-- 'ASetter' and 'AnIndexedSetter' as appropriate. If a function takes this it is 149-- expecting one of those two things based on context. 150type Setting p s t a b = p a (Identity b) -> s -> Identity t 151 152-- | This is a convenient alias when defining highly polymorphic code that takes both 153-- 'ASetter'' and 'AnIndexedSetter'' as appropriate. If a function takes this it is 154-- expecting one of those two things based on context. 155type Setting' p s a = Setting p s s a a 156 157----------------------------------------------------------------------------- 158-- Setters 159----------------------------------------------------------------------------- 160 161-- | This 'Setter' can be used to map over all of the values in a 'Functor'. 162-- 163-- @ 164-- 'fmap' ≡ 'over' 'mapped' 165-- 'Data.Traversable.fmapDefault' ≡ 'over' 'Data.Traversable.traverse' 166-- ('<$') ≡ 'set' 'mapped' 167-- @ 168-- 169-- >>> over mapped f [a,b,c] 170-- [f a,f b,f c] 171-- 172-- >>> over mapped (+1) [1,2,3] 173-- [2,3,4] 174-- 175-- >>> set mapped x [a,b,c] 176-- [x,x,x] 177-- 178-- >>> [[a,b],[c]] & mapped.mapped +~ x 179-- [[a + x,b + x],[c + x]] 180-- 181-- >>> over (mapped._2) length [("hello","world"),("leaders","!!!")] 182-- [("hello",5),("leaders",3)] 183-- 184-- @ 185-- 'mapped' :: 'Functor' f => 'Setter' (f a) (f b) a b 186-- @ 187-- 188-- If you want an 'IndexPreservingSetter' use @'setting' 'fmap'@. 189mapped :: Functor f => Setter (f a) (f b) a b 190mapped = sets fmap 191{-# INLINE mapped #-} 192 193-- | This 'setter' can be used to modify all of the values in a 'Monad'. 194-- 195-- You sometimes have to use this rather than 'mapped' -- due to 196-- temporary insanity 'Functor' was not a superclass of 'Monad' until 197-- GHC 7.10. 198-- 199-- @ 200-- 'liftM' ≡ 'over' 'lifted' 201-- @ 202-- 203-- >>> over lifted f [a,b,c] 204-- [f a,f b,f c] 205-- 206-- >>> set lifted b (Just a) 207-- Just b 208-- 209-- If you want an 'IndexPreservingSetter' use @'setting' 'liftM'@. 210lifted :: Monad m => Setter (m a) (m b) a b 211lifted = sets liftM 212{-# INLINE lifted #-} 213 214-- | This 'Setter' can be used to map over all of the inputs to a 'Contravariant'. 215-- 216-- @ 217-- 'contramap' ≡ 'over' 'contramapped' 218-- @ 219-- 220-- >>> getPredicate (over contramapped (*2) (Predicate even)) 5 221-- True 222-- 223-- >>> getOp (over contramapped (*5) (Op show)) 100 224-- "500" 225-- 226-- >>> Prelude.map ($ 1) $ over (mapped . _Unwrapping' Op . contramapped) (*12) [(*2),(+1),(^3)] 227-- [24,13,1728] 228-- 229contramapped :: Contravariant f => Setter (f b) (f a) a b 230contramapped = sets contramap 231{-# INLINE contramapped #-} 232 233-- | This 'Setter' can be used to map over the input of a 'Profunctor'. 234-- 235-- The most common 'Profunctor' to use this with is @(->)@. 236-- 237-- >>> (argument %~ f) g x 238-- g (f x) 239-- 240-- >>> (argument %~ show) length [1,2,3] 241-- 7 242-- 243-- >>> (argument %~ f) h x y 244-- h (f x) y 245-- 246-- Map over the argument of the result of a function -- i.e., its second 247-- argument: 248-- 249-- >>> (mapped.argument %~ f) h x y 250-- h x (f y) 251-- 252-- @ 253-- 'argument' :: 'Setter' (b -> r) (a -> r) a b 254-- @ 255argument :: Profunctor p => Setter (p b r) (p a r) a b 256argument = sets lmap 257{-# INLINE argument #-} 258 259-- | Build an index-preserving 'Setter' from a map-like function. 260-- 261-- Your supplied function @f@ is required to satisfy: 262-- 263-- @ 264-- f 'id' ≡ 'id' 265-- f g '.' f h ≡ f (g '.' h) 266-- @ 267-- 268-- Equational reasoning: 269-- 270-- @ 271-- 'setting' '.' 'over' ≡ 'id' 272-- 'over' '.' 'setting' ≡ 'id' 273-- @ 274-- 275-- Another way to view 'sets' is that it takes a \"semantic editor combinator\" 276-- and transforms it into a 'Setter'. 277-- 278-- @ 279-- 'setting' :: ((a -> b) -> s -> t) -> 'Setter' s t a b 280-- @ 281setting :: ((a -> b) -> s -> t) -> IndexPreservingSetter s t a b 282setting l pafb = cotabulate $ \ws -> pure $ l (\a -> untainted (cosieve pafb (a <$ ws))) (extract ws) 283{-# INLINE setting #-} 284 285-- | Build a 'Setter', 'IndexedSetter' or 'IndexPreservingSetter' depending on your choice of 'Profunctor'. 286-- 287-- @ 288-- 'sets' :: ((a -> b) -> s -> t) -> 'Setter' s t a b 289-- @ 290sets :: (Profunctor p, Profunctor q, Settable f) => (p a b -> q s t) -> Optical p q f s t a b 291sets f g = taintedDot (f (untaintedDot g)) 292{-# INLINE sets #-} 293 294-- | Restore 'ASetter' to a full 'Setter'. 295cloneSetter :: ASetter s t a b -> Setter s t a b 296cloneSetter l afb = taintedDot $ runIdentity #. l (Identity #. untaintedDot afb) 297{-# INLINE cloneSetter #-} 298 299-- | Build an 'IndexPreservingSetter' from any 'Setter'. 300cloneIndexPreservingSetter :: ASetter s t a b -> IndexPreservingSetter s t a b 301cloneIndexPreservingSetter l pafb = cotabulate $ \ws -> 302 taintedDot runIdentity $ l (\a -> Identity (untainted (cosieve pafb (a <$ ws)))) (extract ws) 303{-# INLINE cloneIndexPreservingSetter #-} 304 305-- | Clone an 'IndexedSetter'. 306cloneIndexedSetter :: AnIndexedSetter i s t a b -> IndexedSetter i s t a b 307cloneIndexedSetter l pafb = taintedDot (runIdentity #. l (Indexed $ \i -> Identity #. untaintedDot (indexed pafb i))) 308{-# INLINE cloneIndexedSetter #-} 309 310----------------------------------------------------------------------------- 311-- Using Setters 312----------------------------------------------------------------------------- 313 314-- | Modify the target of a 'Lens' or all the targets of a 'Setter' or 'Traversal' 315-- with a function. 316-- 317-- @ 318-- 'fmap' ≡ 'over' 'mapped' 319-- 'Data.Traversable.fmapDefault' ≡ 'over' 'Data.Traversable.traverse' 320-- 'sets' '.' 'over' ≡ 'id' 321-- 'over' '.' 'sets' ≡ 'id' 322-- @ 323-- 324-- Given any valid 'Setter' @l@, you can also rely on the law: 325-- 326-- @ 327-- 'over' l f '.' 'over' l g = 'over' l (f '.' g) 328-- @ 329-- 330-- /e.g./ 331-- 332-- >>> over mapped f (over mapped g [a,b,c]) == over mapped (f . g) [a,b,c] 333-- True 334-- 335-- Another way to view 'over' is to say that it transforms a 'Setter' into a 336-- \"semantic editor combinator\". 337-- 338-- >>> over mapped f (Just a) 339-- Just (f a) 340-- 341-- >>> over mapped (*10) [1,2,3] 342-- [10,20,30] 343-- 344-- >>> over _1 f (a,b) 345-- (f a,b) 346-- 347-- >>> over _1 show (10,20) 348-- ("10",20) 349-- 350-- @ 351-- 'over' :: 'Setter' s t a b -> (a -> b) -> s -> t 352-- 'over' :: 'ASetter' s t a b -> (a -> b) -> s -> t 353-- @ 354over :: ASetter s t a b -> (a -> b) -> s -> t 355over l f = runIdentity #. l (Identity #. f) 356{-# INLINE over #-} 357 358-- | Replace the target of a 'Lens' or all of the targets of a 'Setter' 359-- or 'Traversal' with a constant value. 360-- 361-- @ 362-- ('<$') ≡ 'set' 'mapped' 363-- @ 364-- 365-- >>> set _2 "hello" (1,()) 366-- (1,"hello") 367-- 368-- >>> set mapped () [1,2,3,4] 369-- [(),(),(),()] 370-- 371-- Note: Attempting to 'set' a 'Fold' or 'Getter' will fail at compile time with an 372-- relatively nice error message. 373-- 374-- @ 375-- 'set' :: 'Setter' s t a b -> b -> s -> t 376-- 'set' :: 'Iso' s t a b -> b -> s -> t 377-- 'set' :: 'Lens' s t a b -> b -> s -> t 378-- 'set' :: 'Traversal' s t a b -> b -> s -> t 379-- @ 380set :: ASetter s t a b -> b -> s -> t 381set l b = runIdentity #. l (\_ -> Identity b) 382{-# INLINE set #-} 383 384-- | Replace the target of a 'Lens' or all of the targets of a 'Setter'' 385-- or 'Traversal' with a constant value, without changing its type. 386-- 387-- This is a type restricted version of 'set', which retains the type of the original. 388-- 389-- >>> set' mapped x [a,b,c,d] 390-- [x,x,x,x] 391-- 392-- >>> set' _2 "hello" (1,"world") 393-- (1,"hello") 394-- 395-- >>> set' mapped 0 [1,2,3,4] 396-- [0,0,0,0] 397-- 398-- Note: Attempting to adjust 'set'' a 'Fold' or 'Getter' will fail at compile time with an 399-- relatively nice error message. 400-- 401-- @ 402-- 'set'' :: 'Setter'' s a -> a -> s -> s 403-- 'set'' :: 'Iso'' s a -> a -> s -> s 404-- 'set'' :: 'Lens'' s a -> a -> s -> s 405-- 'set'' :: 'Traversal'' s a -> a -> s -> s 406-- @ 407set' :: ASetter' s a -> a -> s -> s 408set' l b = runIdentity #. l (\_ -> Identity b) 409{-# INLINE set' #-} 410 411-- | Modifies the target of a 'Lens' or all of the targets of a 'Setter' or 412-- 'Traversal' with a user supplied function. 413-- 414-- This is an infix version of 'over'. 415-- 416-- @ 417-- 'fmap' f ≡ 'mapped' '%~' f 418-- 'Data.Traversable.fmapDefault' f ≡ 'Data.Traversable.traverse' '%~' f 419-- @ 420-- 421-- >>> (a,b,c) & _3 %~ f 422-- (a,b,f c) 423-- 424-- >>> (a,b) & both %~ f 425-- (f a,f b) 426-- 427-- >>> _2 %~ length $ (1,"hello") 428-- (1,5) 429-- 430-- >>> traverse %~ f $ [a,b,c] 431-- [f a,f b,f c] 432-- 433-- >>> traverse %~ even $ [1,2,3] 434-- [False,True,False] 435-- 436-- >>> traverse.traverse %~ length $ [["hello","world"],["!!!"]] 437-- [[5,5],[3]] 438-- 439-- @ 440-- ('%~') :: 'Setter' s t a b -> (a -> b) -> s -> t 441-- ('%~') :: 'Iso' s t a b -> (a -> b) -> s -> t 442-- ('%~') :: 'Lens' s t a b -> (a -> b) -> s -> t 443-- ('%~') :: 'Traversal' s t a b -> (a -> b) -> s -> t 444-- @ 445(%~) :: ASetter s t a b -> (a -> b) -> s -> t 446(%~) = over 447{-# INLINE (%~) #-} 448 449-- | Replace the target of a 'Lens' or all of the targets of a 'Setter' 450-- or 'Traversal' with a constant value. 451-- 452-- This is an infix version of 'set', provided for consistency with ('.='). 453-- 454-- @ 455-- f '<$' a ≡ 'mapped' '.~' f '$' a 456-- @ 457-- 458-- >>> (a,b,c,d) & _4 .~ e 459-- (a,b,c,e) 460-- 461-- >>> (42,"world") & _1 .~ "hello" 462-- ("hello","world") 463-- 464-- >>> (a,b) & both .~ c 465-- (c,c) 466-- 467-- @ 468-- ('.~') :: 'Setter' s t a b -> b -> s -> t 469-- ('.~') :: 'Iso' s t a b -> b -> s -> t 470-- ('.~') :: 'Lens' s t a b -> b -> s -> t 471-- ('.~') :: 'Traversal' s t a b -> b -> s -> t 472-- @ 473(.~) :: ASetter s t a b -> b -> s -> t 474(.~) = set 475{-# INLINE (.~) #-} 476 477-- | Set the target of a 'Lens', 'Traversal' or 'Setter' to 'Just' a value. 478-- 479-- @ 480-- l '?~' t ≡ 'set' l ('Just' t) 481-- @ 482-- 483-- >>> Nothing & id ?~ a 484-- Just a 485-- 486-- >>> Map.empty & at 3 ?~ x 487-- fromList [(3,x)] 488-- 489-- '?~' can be used type-changily: 490-- 491-- >>> ('a', ('b', 'c')) & _2.both ?~ 'x' 492-- ('a',(Just 'x',Just 'x')) 493-- 494-- @ 495-- ('?~') :: 'Setter' s t a ('Maybe' b) -> b -> s -> t 496-- ('?~') :: 'Iso' s t a ('Maybe' b) -> b -> s -> t 497-- ('?~') :: 'Lens' s t a ('Maybe' b) -> b -> s -> t 498-- ('?~') :: 'Traversal' s t a ('Maybe' b) -> b -> s -> t 499-- @ 500(?~) :: ASetter s t a (Maybe b) -> b -> s -> t 501l ?~ b = set l (Just b) 502{-# INLINE (?~) #-} 503 504-- | Set with pass-through. 505-- 506-- This is mostly present for consistency, but may be useful for chaining assignments. 507-- 508-- If you do not need a copy of the intermediate result, then using @l '.~' t@ directly is a good idea. 509-- 510-- >>> (a,b) & _1 <.~ c 511-- (c,(c,b)) 512-- 513-- >>> ("good","morning","vietnam") & _3 <.~ "world" 514-- ("world",("good","morning","world")) 515-- 516-- >>> (42,Map.fromList [("goodnight","gracie")]) & _2.at "hello" <.~ Just "world" 517-- (Just "world",(42,fromList [("goodnight","gracie"),("hello","world")])) 518-- 519-- @ 520-- ('<.~') :: 'Setter' s t a b -> b -> s -> (b, t) 521-- ('<.~') :: 'Iso' s t a b -> b -> s -> (b, t) 522-- ('<.~') :: 'Lens' s t a b -> b -> s -> (b, t) 523-- ('<.~') :: 'Traversal' s t a b -> b -> s -> (b, t) 524-- @ 525(<.~) :: ASetter s t a b -> b -> s -> (b, t) 526l <.~ b = \s -> (b, set l b s) 527{-# INLINE (<.~) #-} 528 529-- | Set to 'Just' a value with pass-through. 530-- 531-- This is mostly present for consistency, but may be useful for for chaining assignments. 532-- 533-- If you do not need a copy of the intermediate result, then using @l '?~' d@ directly is a good idea. 534-- 535-- >>> import Data.Map as Map 536-- >>> _2.at "hello" <?~ "world" $ (42,Map.fromList [("goodnight","gracie")]) 537-- ("world",(42,fromList [("goodnight","gracie"),("hello","world")])) 538-- 539-- @ 540-- ('<?~') :: 'Setter' s t a ('Maybe' b) -> b -> s -> (b, t) 541-- ('<?~') :: 'Iso' s t a ('Maybe' b) -> b -> s -> (b, t) 542-- ('<?~') :: 'Lens' s t a ('Maybe' b) -> b -> s -> (b, t) 543-- ('<?~') :: 'Traversal' s t a ('Maybe' b) -> b -> s -> (b, t) 544-- @ 545(<?~) :: ASetter s t a (Maybe b) -> b -> s -> (b, t) 546l <?~ b = \s -> (b, set l (Just b) s) 547{-# INLINE (<?~) #-} 548 549-- | Increment the target(s) of a numerically valued 'Lens', 'Setter' or 'Traversal'. 550-- 551-- >>> (a,b) & _1 +~ c 552-- (a + c,b) 553-- 554-- >>> (a,b) & both +~ c 555-- (a + c,b + c) 556-- 557-- >>> (1,2) & _2 +~ 1 558-- (1,3) 559-- 560-- >>> [(a,b),(c,d)] & traverse.both +~ e 561-- [(a + e,b + e),(c + e,d + e)] 562-- 563-- @ 564-- ('+~') :: 'Num' a => 'Setter'' s a -> a -> s -> s 565-- ('+~') :: 'Num' a => 'Iso'' s a -> a -> s -> s 566-- ('+~') :: 'Num' a => 'Lens'' s a -> a -> s -> s 567-- ('+~') :: 'Num' a => 'Traversal'' s a -> a -> s -> s 568-- @ 569(+~) :: Num a => ASetter s t a a -> a -> s -> t 570l +~ n = over l (+ n) 571{-# INLINE (+~) #-} 572 573-- | Multiply the target(s) of a numerically valued 'Lens', 'Iso', 'Setter' or 'Traversal'. 574-- 575-- >>> (a,b) & _1 *~ c 576-- (a * c,b) 577-- 578-- >>> (a,b) & both *~ c 579-- (a * c,b * c) 580-- 581-- >>> (1,2) & _2 *~ 4 582-- (1,8) 583-- 584-- >>> Just 24 & mapped *~ 2 585-- Just 48 586-- 587-- @ 588-- ('*~') :: 'Num' a => 'Setter'' s a -> a -> s -> s 589-- ('*~') :: 'Num' a => 'Iso'' s a -> a -> s -> s 590-- ('*~') :: 'Num' a => 'Lens'' s a -> a -> s -> s 591-- ('*~') :: 'Num' a => 'Traversal'' s a -> a -> s -> s 592-- @ 593(*~) :: Num a => ASetter s t a a -> a -> s -> t 594l *~ n = over l (* n) 595{-# INLINE (*~) #-} 596 597-- | Decrement the target(s) of a numerically valued 'Lens', 'Iso', 'Setter' or 'Traversal'. 598-- 599-- >>> (a,b) & _1 -~ c 600-- (a - c,b) 601-- 602-- >>> (a,b) & both -~ c 603-- (a - c,b - c) 604-- 605-- >>> _1 -~ 2 $ (1,2) 606-- (-1,2) 607-- 608-- >>> mapped.mapped -~ 1 $ [[4,5],[6,7]] 609-- [[3,4],[5,6]] 610-- 611-- @ 612-- ('-~') :: 'Num' a => 'Setter'' s a -> a -> s -> s 613-- ('-~') :: 'Num' a => 'Iso'' s a -> a -> s -> s 614-- ('-~') :: 'Num' a => 'Lens'' s a -> a -> s -> s 615-- ('-~') :: 'Num' a => 'Traversal'' s a -> a -> s -> s 616-- @ 617(-~) :: Num a => ASetter s t a a -> a -> s -> t 618l -~ n = over l (subtract n) 619{-# INLINE (-~) #-} 620 621-- | Divide the target(s) of a numerically valued 'Lens', 'Iso', 'Setter' or 'Traversal'. 622-- 623-- >>> (a,b) & _1 //~ c 624-- (a / c,b) 625-- 626-- >>> (a,b) & both //~ c 627-- (a / c,b / c) 628-- 629-- >>> ("Hawaii",10) & _2 //~ 2 630-- ("Hawaii",5.0) 631-- 632-- @ 633-- ('//~') :: 'Fractional' a => 'Setter'' s a -> a -> s -> s 634-- ('//~') :: 'Fractional' a => 'Iso'' s a -> a -> s -> s 635-- ('//~') :: 'Fractional' a => 'Lens'' s a -> a -> s -> s 636-- ('//~') :: 'Fractional' a => 'Traversal'' s a -> a -> s -> s 637-- @ 638(//~) :: Fractional a => ASetter s t a a -> a -> s -> t 639l //~ n = over l (/ n) 640{-# INLINE (//~) #-} 641 642-- | Raise the target(s) of a numerically valued 'Lens', 'Setter' or 'Traversal' to a non-negative integral power. 643-- 644-- >>> (1,3) & _2 ^~ 2 645-- (1,9) 646-- 647-- @ 648-- ('^~') :: ('Num' a, 'Integral' e) => 'Setter'' s a -> e -> s -> s 649-- ('^~') :: ('Num' a, 'Integral' e) => 'Iso'' s a -> e -> s -> s 650-- ('^~') :: ('Num' a, 'Integral' e) => 'Lens'' s a -> e -> s -> s 651-- ('^~') :: ('Num' a, 'Integral' e) => 'Traversal'' s a -> e -> s -> s 652-- @ 653(^~) :: (Num a, Integral e) => ASetter s t a a -> e -> s -> t 654l ^~ n = over l (^ n) 655{-# INLINE (^~) #-} 656 657-- | Raise the target(s) of a fractionally valued 'Lens', 'Setter' or 'Traversal' to an integral power. 658-- 659-- >>> (1,2) & _2 ^^~ (-1) 660-- (1,0.5) 661-- 662-- @ 663-- ('^^~') :: ('Fractional' a, 'Integral' e) => 'Setter'' s a -> e -> s -> s 664-- ('^^~') :: ('Fractional' a, 'Integral' e) => 'Iso'' s a -> e -> s -> s 665-- ('^^~') :: ('Fractional' a, 'Integral' e) => 'Lens'' s a -> e -> s -> s 666-- ('^^~') :: ('Fractional' a, 'Integral' e) => 'Traversal'' s a -> e -> s -> s 667-- @ 668-- 669(^^~) :: (Fractional a, Integral e) => ASetter s t a a -> e -> s -> t 670l ^^~ n = over l (^^ n) 671{-# INLINE (^^~) #-} 672 673-- | Raise the target(s) of a floating-point valued 'Lens', 'Setter' or 'Traversal' to an arbitrary power. 674-- 675-- >>> (a,b) & _1 **~ c 676-- (a**c,b) 677-- 678-- >>> (a,b) & both **~ c 679-- (a**c,b**c) 680-- 681-- >>> _2 **~ 10 $ (3,2) 682-- (3,1024.0) 683-- 684-- @ 685-- ('**~') :: 'Floating' a => 'Setter'' s a -> a -> s -> s 686-- ('**~') :: 'Floating' a => 'Iso'' s a -> a -> s -> s 687-- ('**~') :: 'Floating' a => 'Lens'' s a -> a -> s -> s 688-- ('**~') :: 'Floating' a => 'Traversal'' s a -> a -> s -> s 689-- @ 690(**~) :: Floating a => ASetter s t a a -> a -> s -> t 691l **~ n = over l (** n) 692{-# INLINE (**~) #-} 693 694-- | Logically '||' the target(s) of a 'Bool'-valued 'Lens' or 'Setter'. 695-- 696-- >>> both ||~ True $ (False,True) 697-- (True,True) 698-- 699-- >>> both ||~ False $ (False,True) 700-- (False,True) 701-- 702-- @ 703-- ('||~') :: 'Setter'' s 'Bool' -> 'Bool' -> s -> s 704-- ('||~') :: 'Iso'' s 'Bool' -> 'Bool' -> s -> s 705-- ('||~') :: 'Lens'' s 'Bool' -> 'Bool' -> s -> s 706-- ('||~') :: 'Traversal'' s 'Bool' -> 'Bool' -> s -> s 707-- @ 708(||~):: ASetter s t Bool Bool -> Bool -> s -> t 709l ||~ n = over l (|| n) 710{-# INLINE (||~) #-} 711 712-- | Logically '&&' the target(s) of a 'Bool'-valued 'Lens' or 'Setter'. 713-- 714-- >>> both &&~ True $ (False, True) 715-- (False,True) 716-- 717-- >>> both &&~ False $ (False, True) 718-- (False,False) 719-- 720-- @ 721-- ('&&~') :: 'Setter'' s 'Bool' -> 'Bool' -> s -> s 722-- ('&&~') :: 'Iso'' s 'Bool' -> 'Bool' -> s -> s 723-- ('&&~') :: 'Lens'' s 'Bool' -> 'Bool' -> s -> s 724-- ('&&~') :: 'Traversal'' s 'Bool' -> 'Bool' -> s -> s 725-- @ 726(&&~) :: ASetter s t Bool Bool -> Bool -> s -> t 727l &&~ n = over l (&& n) 728{-# INLINE (&&~) #-} 729 730------------------------------------------------------------------------------ 731-- Using Setters with State 732------------------------------------------------------------------------------ 733 734-- | Replace the target of a 'Lens' or all of the targets of a 'Setter' or 'Traversal' in our monadic 735-- state with a new value, irrespective of the old. 736-- 737-- This is an alias for ('.='). 738-- 739-- >>> execState (do assign _1 c; assign _2 d) (a,b) 740-- (c,d) 741-- 742-- >>> execState (both .= c) (a,b) 743-- (c,c) 744-- 745-- @ 746-- 'assign' :: 'MonadState' s m => 'Iso'' s a -> a -> m () 747-- 'assign' :: 'MonadState' s m => 'Lens'' s a -> a -> m () 748-- 'assign' :: 'MonadState' s m => 'Traversal'' s a -> a -> m () 749-- 'assign' :: 'MonadState' s m => 'Setter'' s a -> a -> m () 750-- @ 751assign :: MonadState s m => ASetter s s a b -> b -> m () 752assign l b = State.modify (set l b) 753{-# INLINE assign #-} 754 755-- | Replace the target of a 'Lens' or all of the targets of a 'Setter' 756-- or 'Traversal' in our monadic state with a new value, irrespective of the 757-- old. 758-- 759-- This is an infix version of 'assign'. 760-- 761-- >>> execState (do _1 .= c; _2 .= d) (a,b) 762-- (c,d) 763-- 764-- >>> execState (both .= c) (a,b) 765-- (c,c) 766-- 767-- @ 768-- ('.=') :: 'MonadState' s m => 'Iso'' s a -> a -> m () 769-- ('.=') :: 'MonadState' s m => 'Lens'' s a -> a -> m () 770-- ('.=') :: 'MonadState' s m => 'Traversal'' s a -> a -> m () 771-- ('.=') :: 'MonadState' s m => 'Setter'' s a -> a -> m () 772-- @ 773-- 774-- /It puts the state in the monad or it gets the hose again./ 775(.=) :: MonadState s m => ASetter s s a b -> b -> m () 776l .= b = State.modify (l .~ b) 777{-# INLINE (.=) #-} 778 779-- | Map over the target of a 'Lens' or all of the targets of a 'Setter' or 'Traversal' in our monadic state. 780-- 781-- >>> execState (do _1 %= f;_2 %= g) (a,b) 782-- (f a,g b) 783-- 784-- >>> execState (do both %= f) (a,b) 785-- (f a,f b) 786-- 787-- @ 788-- ('%=') :: 'MonadState' s m => 'Iso'' s a -> (a -> a) -> m () 789-- ('%=') :: 'MonadState' s m => 'Lens'' s a -> (a -> a) -> m () 790-- ('%=') :: 'MonadState' s m => 'Traversal'' s a -> (a -> a) -> m () 791-- ('%=') :: 'MonadState' s m => 'Setter'' s a -> (a -> a) -> m () 792-- @ 793-- 794-- @ 795-- ('%=') :: 'MonadState' s m => 'ASetter' s s a b -> (a -> b) -> m () 796-- @ 797(%=) :: MonadState s m => ASetter s s a b -> (a -> b) -> m () 798l %= f = State.modify (l %~ f) 799{-# INLINE (%=) #-} 800 801-- | This is an alias for ('%='). 802modifying :: MonadState s m => ASetter s s a b -> (a -> b) -> m () 803modifying l f = State.modify (over l f) 804{-# INLINE modifying #-} 805 806-- | Replace the target of a 'Lens' or all of the targets of a 'Setter' or 'Traversal' in our monadic 807-- state with 'Just' a new value, irrespective of the old. 808-- 809-- >>> execState (do at 1 ?= a; at 2 ?= b) Map.empty 810-- fromList [(1,a),(2,b)] 811-- 812-- >>> execState (do _1 ?= b; _2 ?= c) (Just a, Nothing) 813-- (Just b,Just c) 814-- 815-- @ 816-- ('?=') :: 'MonadState' s m => 'Iso'' s ('Maybe' a) -> a -> m () 817-- ('?=') :: 'MonadState' s m => 'Lens'' s ('Maybe' a) -> a -> m () 818-- ('?=') :: 'MonadState' s m => 'Traversal'' s ('Maybe' a) -> a -> m () 819-- ('?=') :: 'MonadState' s m => 'Setter'' s ('Maybe' a) -> a -> m () 820-- @ 821(?=) :: MonadState s m => ASetter s s a (Maybe b) -> b -> m () 822l ?= b = State.modify (l ?~ b) 823{-# INLINE (?=) #-} 824 825-- | Modify the target(s) of a 'Lens'', 'Iso', 'Setter' or 'Traversal' by adding a value. 826-- 827-- Example: 828-- 829-- @ 830-- 'fresh' :: 'MonadState' 'Int' m => m 'Int' 831-- 'fresh' = do 832-- 'id' '+=' 1 833-- 'Control.Lens.Getter.use' 'id' 834-- @ 835-- 836-- >>> execState (do _1 += c; _2 += d) (a,b) 837-- (a + c,b + d) 838-- 839-- >>> execState (do _1.at 1.non 0 += 10) (Map.fromList [(2,100)],"hello") 840-- (fromList [(1,10),(2,100)],"hello") 841-- 842-- @ 843-- ('+=') :: ('MonadState' s m, 'Num' a) => 'Setter'' s a -> a -> m () 844-- ('+=') :: ('MonadState' s m, 'Num' a) => 'Iso'' s a -> a -> m () 845-- ('+=') :: ('MonadState' s m, 'Num' a) => 'Lens'' s a -> a -> m () 846-- ('+=') :: ('MonadState' s m, 'Num' a) => 'Traversal'' s a -> a -> m () 847-- @ 848(+=) :: (MonadState s m, Num a) => ASetter' s a -> a -> m () 849l += b = State.modify (l +~ b) 850{-# INLINE (+=) #-} 851 852-- | Modify the target(s) of a 'Lens'', 'Iso', 'Setter' or 'Traversal' by subtracting a value. 853-- 854-- >>> execState (do _1 -= c; _2 -= d) (a,b) 855-- (a - c,b - d) 856-- 857-- @ 858-- ('-=') :: ('MonadState' s m, 'Num' a) => 'Setter'' s a -> a -> m () 859-- ('-=') :: ('MonadState' s m, 'Num' a) => 'Iso'' s a -> a -> m () 860-- ('-=') :: ('MonadState' s m, 'Num' a) => 'Lens'' s a -> a -> m () 861-- ('-=') :: ('MonadState' s m, 'Num' a) => 'Traversal'' s a -> a -> m () 862-- @ 863(-=) :: (MonadState s m, Num a) => ASetter' s a -> a -> m () 864l -= b = State.modify (l -~ b) 865{-# INLINE (-=) #-} 866 867-- | Modify the target(s) of a 'Lens'', 'Iso', 'Setter' or 'Traversal' by multiplying by value. 868-- 869-- >>> execState (do _1 *= c; _2 *= d) (a,b) 870-- (a * c,b * d) 871-- 872-- @ 873-- ('*=') :: ('MonadState' s m, 'Num' a) => 'Setter'' s a -> a -> m () 874-- ('*=') :: ('MonadState' s m, 'Num' a) => 'Iso'' s a -> a -> m () 875-- ('*=') :: ('MonadState' s m, 'Num' a) => 'Lens'' s a -> a -> m () 876-- ('*=') :: ('MonadState' s m, 'Num' a) => 'Traversal'' s a -> a -> m () 877-- @ 878(*=) :: (MonadState s m, Num a) => ASetter' s a -> a -> m () 879l *= b = State.modify (l *~ b) 880{-# INLINE (*=) #-} 881 882-- | Modify the target(s) of a 'Lens'', 'Iso', 'Setter' or 'Traversal' by dividing by a value. 883-- 884-- >>> execState (do _1 //= c; _2 //= d) (a,b) 885-- (a / c,b / d) 886-- 887-- @ 888-- ('//=') :: ('MonadState' s m, 'Fractional' a) => 'Setter'' s a -> a -> m () 889-- ('//=') :: ('MonadState' s m, 'Fractional' a) => 'Iso'' s a -> a -> m () 890-- ('//=') :: ('MonadState' s m, 'Fractional' a) => 'Lens'' s a -> a -> m () 891-- ('//=') :: ('MonadState' s m, 'Fractional' a) => 'Traversal'' s a -> a -> m () 892-- @ 893(//=) :: (MonadState s m, Fractional a) => ASetter' s a -> a -> m () 894l //= a = State.modify (l //~ a) 895{-# INLINE (//=) #-} 896 897-- | Raise the target(s) of a numerically valued 'Lens', 'Setter' or 'Traversal' to a non-negative integral power. 898-- 899-- @ 900-- ('^=') :: ('MonadState' s m, 'Num' a, 'Integral' e) => 'Setter'' s a -> e -> m () 901-- ('^=') :: ('MonadState' s m, 'Num' a, 'Integral' e) => 'Iso'' s a -> e -> m () 902-- ('^=') :: ('MonadState' s m, 'Num' a, 'Integral' e) => 'Lens'' s a -> e -> m () 903-- ('^=') :: ('MonadState' s m, 'Num' a, 'Integral' e) => 'Traversal'' s a -> e -> m () 904-- @ 905(^=) :: (MonadState s m, Num a, Integral e) => ASetter' s a -> e -> m () 906l ^= e = State.modify (l ^~ e) 907{-# INLINE (^=) #-} 908 909-- | Raise the target(s) of a numerically valued 'Lens', 'Setter' or 'Traversal' to an integral power. 910-- 911-- @ 912-- ('^^=') :: ('MonadState' s m, 'Fractional' a, 'Integral' e) => 'Setter'' s a -> e -> m () 913-- ('^^=') :: ('MonadState' s m, 'Fractional' a, 'Integral' e) => 'Iso'' s a -> e -> m () 914-- ('^^=') :: ('MonadState' s m, 'Fractional' a, 'Integral' e) => 'Lens'' s a -> e -> m () 915-- ('^^=') :: ('MonadState' s m, 'Fractional' a, 'Integral' e) => 'Traversal'' s a -> e -> m () 916-- @ 917(^^=) :: (MonadState s m, Fractional a, Integral e) => ASetter' s a -> e -> m () 918l ^^= e = State.modify (l ^^~ e) 919{-# INLINE (^^=) #-} 920 921-- | Raise the target(s) of a numerically valued 'Lens', 'Setter' or 'Traversal' to an arbitrary power 922-- 923-- >>> execState (do _1 **= c; _2 **= d) (a,b) 924-- (a**c,b**d) 925-- 926-- @ 927-- ('**=') :: ('MonadState' s m, 'Floating' a) => 'Setter'' s a -> a -> m () 928-- ('**=') :: ('MonadState' s m, 'Floating' a) => 'Iso'' s a -> a -> m () 929-- ('**=') :: ('MonadState' s m, 'Floating' a) => 'Lens'' s a -> a -> m () 930-- ('**=') :: ('MonadState' s m, 'Floating' a) => 'Traversal'' s a -> a -> m () 931-- @ 932(**=) :: (MonadState s m, Floating a) => ASetter' s a -> a -> m () 933l **= a = State.modify (l **~ a) 934{-# INLINE (**=) #-} 935 936-- | Modify the target(s) of a 'Lens'', 'Iso', 'Setter' or 'Traversal' by taking their logical '&&' with a value. 937-- 938-- >>> execState (do _1 &&= True; _2 &&= False; _3 &&= True; _4 &&= False) (True,True,False,False) 939-- (True,False,False,False) 940-- 941-- @ 942-- ('&&=') :: 'MonadState' s m => 'Setter'' s 'Bool' -> 'Bool' -> m () 943-- ('&&=') :: 'MonadState' s m => 'Iso'' s 'Bool' -> 'Bool' -> m () 944-- ('&&=') :: 'MonadState' s m => 'Lens'' s 'Bool' -> 'Bool' -> m () 945-- ('&&=') :: 'MonadState' s m => 'Traversal'' s 'Bool' -> 'Bool' -> m () 946-- @ 947(&&=):: MonadState s m => ASetter' s Bool -> Bool -> m () 948l &&= b = State.modify (l &&~ b) 949{-# INLINE (&&=) #-} 950 951-- | Modify the target(s) of a 'Lens'', 'Iso, 'Setter' or 'Traversal' by taking their logical '||' with a value. 952-- 953-- >>> execState (do _1 ||= True; _2 ||= False; _3 ||= True; _4 ||= False) (True,True,False,False) 954-- (True,True,True,False) 955-- 956-- @ 957-- ('||=') :: 'MonadState' s m => 'Setter'' s 'Bool' -> 'Bool' -> m () 958-- ('||=') :: 'MonadState' s m => 'Iso'' s 'Bool' -> 'Bool' -> m () 959-- ('||=') :: 'MonadState' s m => 'Lens'' s 'Bool' -> 'Bool' -> m () 960-- ('||=') :: 'MonadState' s m => 'Traversal'' s 'Bool' -> 'Bool' -> m () 961-- @ 962(||=) :: MonadState s m => ASetter' s Bool -> Bool -> m () 963l ||= b = State.modify (l ||~ b) 964{-# INLINE (||=) #-} 965 966-- | Run a monadic action, and set all of the targets of a 'Lens', 'Setter' or 'Traversal' to its result. 967-- 968-- @ 969-- ('<~') :: 'MonadState' s m => 'Iso' s s a b -> m b -> m () 970-- ('<~') :: 'MonadState' s m => 'Lens' s s a b -> m b -> m () 971-- ('<~') :: 'MonadState' s m => 'Traversal' s s a b -> m b -> m () 972-- ('<~') :: 'MonadState' s m => 'Setter' s s a b -> m b -> m () 973-- @ 974-- 975-- As a reasonable mnemonic, this lets you store the result of a monadic action in a 'Lens' rather than 976-- in a local variable. 977-- 978-- @ 979-- do foo <- bar 980-- ... 981-- @ 982-- 983-- will store the result in a variable, while 984-- 985-- @ 986-- do foo '<~' bar 987-- ... 988-- @ 989-- 990-- will store the result in a 'Lens', 'Setter', or 'Traversal'. 991(<~) :: MonadState s m => ASetter s s a b -> m b -> m () 992l <~ mb = mb >>= (l .=) 993{-# INLINE (<~) #-} 994 995-- | Set with pass-through 996-- 997-- This is useful for chaining assignment without round-tripping through your 'Monad' stack. 998-- 999-- @ 1000-- do x <- 'Control.Lens.Tuple._2' '<.=' ninety_nine_bottles_of_beer_on_the_wall 1001-- @ 1002-- 1003-- If you do not need a copy of the intermediate result, then using @l '.=' d@ will avoid unused binding warnings. 1004-- 1005-- @ 1006-- ('<.=') :: 'MonadState' s m => 'Setter' s s a b -> b -> m b 1007-- ('<.=') :: 'MonadState' s m => 'Iso' s s a b -> b -> m b 1008-- ('<.=') :: 'MonadState' s m => 'Lens' s s a b -> b -> m b 1009-- ('<.=') :: 'MonadState' s m => 'Traversal' s s a b -> b -> m b 1010-- @ 1011(<.=) :: MonadState s m => ASetter s s a b -> b -> m b 1012l <.= b = do 1013 l .= b 1014 return b 1015{-# INLINE (<.=) #-} 1016 1017-- | Set 'Just' a value with pass-through 1018-- 1019-- This is useful for chaining assignment without round-tripping through your 'Monad' stack. 1020-- 1021-- @ 1022-- do x <- 'Control.Lens.At.at' "foo" '<?=' ninety_nine_bottles_of_beer_on_the_wall 1023-- @ 1024-- 1025-- If you do not need a copy of the intermediate result, then using @l '?=' d@ will avoid unused binding warnings. 1026-- 1027-- @ 1028-- ('<?=') :: 'MonadState' s m => 'Setter' s s a ('Maybe' b) -> b -> m b 1029-- ('<?=') :: 'MonadState' s m => 'Iso' s s a ('Maybe' b) -> b -> m b 1030-- ('<?=') :: 'MonadState' s m => 'Lens' s s a ('Maybe' b) -> b -> m b 1031-- ('<?=') :: 'MonadState' s m => 'Traversal' s s a ('Maybe' b) -> b -> m b 1032-- @ 1033(<?=) :: MonadState s m => ASetter s s a (Maybe b) -> b -> m b 1034l <?= b = do 1035 l ?= b 1036 return b 1037{-# INLINE (<?=) #-} 1038 1039-- | Modify the target of a 'Semigroup' value by using @('<>')@. 1040-- 1041-- >>> (Sum a,b) & _1 <>~ Sum c 1042-- (Sum {getSum = a + c},b) 1043-- 1044-- >>> (Sum a,Sum b) & both <>~ Sum c 1045-- (Sum {getSum = a + c},Sum {getSum = b + c}) 1046-- 1047-- >>> both <>~ "!!!" $ ("hello","world") 1048-- ("hello!!!","world!!!") 1049-- 1050-- @ 1051-- ('<>~') :: 'Semigroup' a => 'Setter' s t a a -> a -> s -> t 1052-- ('<>~') :: 'Semigroup' a => 'Iso' s t a a -> a -> s -> t 1053-- ('<>~') :: 'Semigroup' a => 'Lens' s t a a -> a -> s -> t 1054-- ('<>~') :: 'Semigroup' a => 'Traversal' s t a a -> a -> s -> t 1055-- @ 1056(<>~) :: Semigroup a => ASetter s t a a -> a -> s -> t 1057l <>~ n = over l (<> n) 1058{-# INLINE (<>~) #-} 1059 1060-- | Modify the target(s) of a 'Lens'', 'Iso', 'Setter' or 'Traversal' by using @('<>')@. 1061-- 1062-- >>> execState (do _1 <>= Sum c; _2 <>= Product d) (Sum a,Product b) 1063-- (Sum {getSum = a + c},Product {getProduct = b * d}) 1064-- 1065-- >>> execState (both <>= "!!!") ("hello","world") 1066-- ("hello!!!","world!!!") 1067-- 1068-- @ 1069-- ('<>=') :: ('MonadState' s m, 'Semigroup' a) => 'Setter'' s a -> a -> m () 1070-- ('<>=') :: ('MonadState' s m, 'Semigroup' a) => 'Iso'' s a -> a -> m () 1071-- ('<>=') :: ('MonadState' s m, 'Semigroup' a) => 'Lens'' s a -> a -> m () 1072-- ('<>=') :: ('MonadState' s m, 'Semigroup' a) => 'Traversal'' s a -> a -> m () 1073-- @ 1074(<>=) :: (MonadState s m, Semigroup a) => ASetter' s a -> a -> m () 1075l <>= a = State.modify (l <>~ a) 1076{-# INLINE (<>=) #-} 1077 1078----------------------------------------------------------------------------- 1079-- Writer Operations 1080----------------------------------------------------------------------------- 1081 1082-- | Write to a fragment of a larger 'Writer' format. 1083scribe :: (MonadWriter t m, Monoid s) => ASetter s t a b -> b -> m () 1084scribe l b = tell (set l b mempty) 1085{-# INLINE scribe #-} 1086 1087-- | This is a generalization of 'pass' that allows you to modify just a 1088-- portion of the resulting 'MonadWriter'. 1089passing :: MonadWriter w m => Setter w w u v -> m (a, u -> v) -> m a 1090passing l m = pass $ do 1091 (a, uv) <- m 1092 return (a, over l uv) 1093{-# INLINE passing #-} 1094 1095-- | This is a generalization of 'pass' that allows you to modify just a 1096-- portion of the resulting 'MonadWriter' with access to the index of an 1097-- 'IndexedSetter'. 1098ipassing :: MonadWriter w m => IndexedSetter i w w u v -> m (a, i -> u -> v) -> m a 1099ipassing l m = pass $ do 1100 (a, uv) <- m 1101 return (a, iover l uv) 1102{-# INLINE ipassing #-} 1103 1104-- | This is a generalization of 'censor' that allows you to 'censor' just a 1105-- portion of the resulting 'MonadWriter'. 1106censoring :: MonadWriter w m => Setter w w u v -> (u -> v) -> m a -> m a 1107censoring l uv = censor (over l uv) 1108{-# INLINE censoring #-} 1109 1110-- | This is a generalization of 'censor' that allows you to 'censor' just a 1111-- portion of the resulting 'MonadWriter', with access to the index of an 1112-- 'IndexedSetter'. 1113icensoring :: MonadWriter w m => IndexedSetter i w w u v -> (i -> u -> v) -> m a -> m a 1114icensoring l uv = censor (iover l uv) 1115{-# INLINE icensoring #-} 1116 1117----------------------------------------------------------------------------- 1118-- Reader Operations 1119----------------------------------------------------------------------------- 1120 1121-- | Modify the value of the 'Reader' environment associated with the target of a 1122-- 'Setter', 'Lens', or 'Traversal'. 1123-- 1124-- @ 1125-- 'locally' l 'id' a ≡ a 1126-- 'locally' l f '.' locally l g ≡ 'locally' l (f '.' g) 1127-- @ 1128-- 1129-- >>> (1,1) & locally _1 (+1) (uncurry (+)) 1130-- 3 1131-- 1132-- >>> "," & locally ($) ("Hello" <>) (<> " world!") 1133-- "Hello, world!" 1134-- 1135-- @ 1136-- locally :: MonadReader s m => 'Iso' s s a b -> (a -> b) -> m r -> m r 1137-- locally :: MonadReader s m => 'Lens' s s a b -> (a -> b) -> m r -> m r 1138-- locally :: MonadReader s m => 'Traversal' s s a b -> (a -> b) -> m r -> m r 1139-- locally :: MonadReader s m => 'Setter' s s a b -> (a -> b) -> m r -> m r 1140-- @ 1141locally :: MonadReader s m => ASetter s s a b -> (a -> b) -> m r -> m r 1142locally l f = Reader.local (over l f) 1143{-# INLINE locally #-} 1144 1145-- | This is a generalization of 'locally' that allows one to make indexed 1146-- 'local' changes to a 'Reader' environment associated with the target of a 1147-- 'Setter', 'Lens', or 'Traversal'. 1148-- 1149-- @ 1150-- 'locally' l f ≡ 'ilocally' l f . const 1151-- 'ilocally' l f ≡ 'locally' l f . 'Indexed' 1152-- @ 1153-- 1154-- @ 1155-- ilocally :: MonadReader s m => 'IndexedLens' s s a b -> (i -> a -> b) -> m r -> m r 1156-- ilocally :: MonadReader s m => 'IndexedTraversal' s s a b -> (i -> a -> b) -> m r -> m r 1157-- ilocally :: MonadReader s m => 'IndexedSetter' s s a b -> (i -> a -> b) -> m r -> m r 1158-- @ 1159ilocally :: MonadReader s m => AnIndexedSetter i s s a b -> (i -> a -> b) -> m r -> m r 1160ilocally l f = Reader.local (iover l f) 1161{-# INLINE ilocally #-} 1162 1163----------------------------------------------------------------------------- 1164-- Indexed Setters 1165----------------------------------------------------------------------------- 1166 1167 1168-- | Map with index. This is an alias for 'imapOf'. 1169-- 1170-- When you do not need access to the index, then 'over' is more liberal in what it can accept. 1171-- 1172-- @ 1173-- 'over' l ≡ 'iover' l '.' 'const' 1174-- 'iover' l ≡ 'over' l '.' 'Indexed' 1175-- @ 1176-- 1177-- @ 1178-- 'iover' :: 'IndexedSetter' i s t a b -> (i -> a -> b) -> s -> t 1179-- 'iover' :: 'IndexedLens' i s t a b -> (i -> a -> b) -> s -> t 1180-- 'iover' :: 'IndexedTraversal' i s t a b -> (i -> a -> b) -> s -> t 1181-- @ 1182iover :: AnIndexedSetter i s t a b -> (i -> a -> b) -> s -> t 1183iover l f = runIdentity #. l (Identity #. Indexed f) 1184{-# INLINE iover #-} 1185 1186-- | Set with index. Equivalent to 'iover' with the current value ignored. 1187-- 1188-- When you do not need access to the index, then 'set' is more liberal in what it can accept. 1189-- 1190-- @ 1191-- 'set' l ≡ 'iset' l '.' 'const' 1192-- @ 1193-- 1194-- @ 1195-- 'iset' :: 'IndexedSetter' i s t a b -> (i -> b) -> s -> t 1196-- 'iset' :: 'IndexedLens' i s t a b -> (i -> b) -> s -> t 1197-- 'iset' :: 'IndexedTraversal' i s t a b -> (i -> b) -> s -> t 1198-- @ 1199iset :: AnIndexedSetter i s t a b -> (i -> b) -> s -> t 1200iset l = iover l . (const .) 1201{-# INLINE iset #-} 1202 1203-- | Build an 'IndexedSetter' from an 'Control.Lens.Indexed.imap'-like function. 1204-- 1205-- Your supplied function @f@ is required to satisfy: 1206-- 1207-- @ 1208-- f 'id' ≡ 'id' 1209-- f g '.' f h ≡ f (g '.' h) 1210-- @ 1211-- 1212-- Equational reasoning: 1213-- 1214-- @ 1215-- 'isets' '.' 'iover' ≡ 'id' 1216-- 'iover' '.' 'isets' ≡ 'id' 1217-- @ 1218-- 1219-- Another way to view 'isets' is that it takes a \"semantic editor combinator\" 1220-- which has been modified to carry an index and transforms it into a 'IndexedSetter'. 1221isets :: ((i -> a -> b) -> s -> t) -> IndexedSetter i s t a b 1222isets f = sets (f . indexed) 1223{-# INLINE isets #-} 1224 1225-- | Adjust every target of an 'IndexedSetter', 'IndexedLens' or 'IndexedTraversal' 1226-- with access to the index. 1227-- 1228-- @ 1229-- ('%@~') ≡ 'iover' 1230-- @ 1231-- 1232-- When you do not need access to the index then ('%~') is more liberal in what it can accept. 1233-- 1234-- @ 1235-- l '%~' f ≡ l '%@~' 'const' f 1236-- @ 1237-- 1238-- @ 1239-- ('%@~') :: 'IndexedSetter' i s t a b -> (i -> a -> b) -> s -> t 1240-- ('%@~') :: 'IndexedLens' i s t a b -> (i -> a -> b) -> s -> t 1241-- ('%@~') :: 'IndexedTraversal' i s t a b -> (i -> a -> b) -> s -> t 1242-- @ 1243(%@~) :: AnIndexedSetter i s t a b -> (i -> a -> b) -> s -> t 1244(%@~) = iover 1245{-# INLINE (%@~) #-} 1246 1247-- | Replace every target of an 'IndexedSetter', 'IndexedLens' or 'IndexedTraversal' 1248-- with access to the index. 1249-- 1250-- @ 1251-- ('.@~') ≡ 'iset' 1252-- @ 1253-- 1254-- When you do not need access to the index then ('.~') is more liberal in what it can accept. 1255-- 1256-- @ 1257-- l '.~' b ≡ l '.@~' 'const' b 1258-- @ 1259-- 1260-- @ 1261-- ('.@~') :: 'IndexedSetter' i s t a b -> (i -> b) -> s -> t 1262-- ('.@~') :: 'IndexedLens' i s t a b -> (i -> b) -> s -> t 1263-- ('.@~') :: 'IndexedTraversal' i s t a b -> (i -> b) -> s -> t 1264-- @ 1265(.@~) :: AnIndexedSetter i s t a b -> (i -> b) -> s -> t 1266l .@~ f = runIdentity #. l (Identity #. Indexed (const . f)) 1267{-# INLINE (.@~) #-} 1268 1269-- | Adjust every target in the current state of an 'IndexedSetter', 'IndexedLens' or 'IndexedTraversal' 1270-- with access to the index. 1271-- 1272-- When you do not need access to the index then ('%=') is more liberal in what it can accept. 1273-- 1274-- @ 1275-- l '%=' f ≡ l '%@=' 'const' f 1276-- @ 1277-- 1278-- @ 1279-- ('%@=') :: 'MonadState' s m => 'IndexedSetter' i s s a b -> (i -> a -> b) -> m () 1280-- ('%@=') :: 'MonadState' s m => 'IndexedLens' i s s a b -> (i -> a -> b) -> m () 1281-- ('%@=') :: 'MonadState' s m => 'IndexedTraversal' i s t a b -> (i -> a -> b) -> m () 1282-- @ 1283(%@=) :: MonadState s m => AnIndexedSetter i s s a b -> (i -> a -> b) -> m () 1284l %@= f = State.modify (l %@~ f) 1285{-# INLINE (%@=) #-} 1286 1287-- | This is an alias for ('%@='). 1288imodifying :: MonadState s m => AnIndexedSetter i s s a b -> (i -> a -> b) -> m () 1289imodifying l f = State.modify (iover l f) 1290{-# INLINE imodifying #-} 1291 1292-- | Replace every target in the current state of an 'IndexedSetter', 'IndexedLens' or 'IndexedTraversal' 1293-- with access to the index. 1294-- 1295-- When you do not need access to the index then ('.=') is more liberal in what it can accept. 1296-- 1297-- @ 1298-- l '.=' b ≡ l '.@=' 'const' b 1299-- @ 1300-- 1301-- @ 1302-- ('.@=') :: 'MonadState' s m => 'IndexedSetter' i s s a b -> (i -> b) -> m () 1303-- ('.@=') :: 'MonadState' s m => 'IndexedLens' i s s a b -> (i -> b) -> m () 1304-- ('.@=') :: 'MonadState' s m => 'IndexedTraversal' i s t a b -> (i -> b) -> m () 1305-- @ 1306(.@=) :: MonadState s m => AnIndexedSetter i s s a b -> (i -> b) -> m () 1307l .@= f = State.modify (l .@~ f) 1308{-# INLINE (.@=) #-} 1309 1310------------------------------------------------------------------------------ 1311-- Arrows 1312------------------------------------------------------------------------------ 1313 1314-- | Run an arrow command and use the output to set all the targets of 1315-- a 'Lens', 'Setter' or 'Traversal' to the result. 1316-- 1317-- 'assignA' can be used very similarly to ('<~'), except that the type of 1318-- the object being modified can change; for example: 1319-- 1320-- @ 1321-- runKleisli action ((), (), ()) where 1322-- action = assignA _1 (Kleisli (const getVal1)) 1323-- \>>> assignA _2 (Kleisli (const getVal2)) 1324-- \>>> assignA _3 (Kleisli (const getVal3)) 1325-- getVal1 :: Either String Int 1326-- getVal1 = ... 1327-- getVal2 :: Either String Bool 1328-- getVal2 = ... 1329-- getVal3 :: Either String Char 1330-- getVal3 = ... 1331-- @ 1332-- 1333-- has the type @'Either' 'String' ('Int', 'Bool', 'Char')@ 1334-- 1335-- @ 1336-- 'assignA' :: 'Arrow' p => 'Iso' s t a b -> p s b -> p s t 1337-- 'assignA' :: 'Arrow' p => 'Lens' s t a b -> p s b -> p s t 1338-- 'assignA' :: 'Arrow' p => 'Traversal' s t a b -> p s b -> p s t 1339-- 'assignA' :: 'Arrow' p => 'Setter' s t a b -> p s b -> p s t 1340-- @ 1341assignA :: Arrow p => ASetter s t a b -> p s b -> p s t 1342assignA l p = arr (flip $ set l) &&& p >>> arr (uncurry id) 1343{-# INLINE assignA #-} 1344 1345------------------------------------------------------------------------------ 1346-- Deprecated 1347------------------------------------------------------------------------------ 1348 1349-- | 'mapOf' is a deprecated alias for 'over'. 1350mapOf :: ASetter s t a b -> (a -> b) -> s -> t 1351mapOf = over 1352{-# INLINE mapOf #-} 1353{-# DEPRECATED mapOf "Use `over`" #-} 1354 1355-- | Map with index. (Deprecated alias for 'iover'). 1356-- 1357-- When you do not need access to the index, then 'mapOf' is more liberal in what it can accept. 1358-- 1359-- @ 1360-- 'mapOf' l ≡ 'imapOf' l '.' 'const' 1361-- @ 1362-- 1363-- @ 1364-- 'imapOf' :: 'IndexedSetter' i s t a b -> (i -> a -> b) -> s -> t 1365-- 'imapOf' :: 'IndexedLens' i s t a b -> (i -> a -> b) -> s -> t 1366-- 'imapOf' :: 'IndexedTraversal' i s t a b -> (i -> a -> b) -> s -> t 1367-- @ 1368imapOf :: AnIndexedSetter i s t a b -> (i -> a -> b) -> s -> t 1369imapOf = iover 1370{-# INLINE imapOf #-} 1371{-# DEPRECATED imapOf "Use `iover`" #-} 1372