packages feed

lens 2.4.0.2 → 2.5

raw patch · 49 files changed

+3327/−1179 lines, 49 filesdep +comonaddep +comonad-transformersdep +comonads-fddep ~basedep ~textdep ~transformers

Dependencies added: comonad, comonad-transformers, comonads-fd, criterion, deepseq, hashable, uniplate, unordered-containers

Dependency ranges changed: base, text, transformers

Files

.travis.yml view
@@ -1,8 +1,15 @@ language: haskell-# Use this when hackage is down.-# before_install:-#   - mkdir -p ~/.cabal-#   - cp config ~/.cabal/config-#   - cabal update+# Use this before_install section when hackage is down.+before_install:+  - mkdir -p ~/.cabal+  - cp config ~/.cabal/config+  - cabal update+  - cabal install --only-dependencies --enable-tests --enable-benchmarks+install:+  - cabal configure --enable-tests --enable-benchmarks+  - cabal build+script:+  - cabal test+  - cabal bench notifications:   irc: "irc.freenode.org#haskell-lens"
CHANGELOG.markdown view
@@ -1,6 +1,20 @@+2.5+---+* Added `Control.Lens.Plated`, a port of Neil Mitchell's `uniplate` that can be used on any `Traversal`.+* Added `Data.Data.Lens` with smart traversals that know how to avoid traversing parts of a structure that can't contain a given type.+* Added `Data.Typeable.Lens` with `_cast` and `_gcast` like `traverseData`+* Renamed `IndexedStore` to `Context` now that it is used in user-visible locations, and since I also use it as `uniplate`'s notion of a context.+* Renamed `Kleene` to `Bazaar` -- "a bazaar contains a bunch of stores."+* Added `Comonad` instances for `Context` and `Bazaar`, so we can use stores directly as the notion of an editable context in uniplate+* Compatibility with both sets of template haskell quirks for GHC 7.6.1-rc1 and the GHC 7.6.1 development head.+* Renamed `children` to `branches` in `Data.Tree.Lens`.+* Added `At` and `Contains` to `Control.Lens.IndexedLens`.+* Added `FunctorWithIndex`, `FoldableWithIndex`, and `TraversableWithIndex` under `Control.Lens.WithIndex`+* Added support for `unordered-containers`.+ 2.4.0.2 --------* GHC 7.6 compatibility+* GHC 7.6.1 development HEAD compatibility (but broke 7.6.1-rc1)  2.4.0.1 -------
README.markdown view
@@ -9,6 +9,11 @@  Documentation is available through [github](https://ekmett.github.com/lens) or [hackage](http://hackage.haskell.org/package/lens). +Plated+------++New in version 2.5 is a port of the `Uniplate` API, updated to use `Traversal`. The Data-derived `biplate` and `uniplate` combinators run about 25% faster than the original `uniplate`, and you can use any of the other combinators, since `biplate` and `uniplate` are now just traversals.+ Examples --------
+ benchmarks/plated.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}+{-# OPTIONS_GHC -funbox-strict-fields #-}+import           Control.Applicative+import           Control.Lens+import           Control.DeepSeq+import           Criterion.Main+import           Data.Data+import           Data.Data.Lens as Data+import qualified Data.Generics.Uniplate.Direct as Uni+import           Data.Generics.Uniplate.Direct ((|*))+import qualified Data.Generics.Uniplate.DataOnly as UniDataOnly+import           GHC.Generics+import           GHC.Generics.Lens as Generic++data Expr  =  Val !Int+           |  Var String+           |  Neg !Expr+           |  Add !Expr !Expr+           |  Sub !Expr !Expr+           |  Mul !Expr !Expr+           |  Div !Expr !Expr+           deriving (Eq,Show,Data,Typeable,Generic)++instance NFData Expr where+  rnf (Neg a)   = rnf a+  rnf (Add a b) = rnf a `seq` rnf b+  rnf (Sub a b) = rnf a `seq` rnf b+  rnf (Mul a b) = rnf a `seq` rnf b+  rnf (Div a b) = rnf a `seq` rnf b+  rnf (Val i)   = rnf i+  rnf (Var s)   = rnf s++instance Plated Expr where+  plate f (Neg a)   = Neg <$> f a+  plate f (Add a b) = Add <$> f a <*> f b+  plate f (Sub a b) = Sub <$> f a <*> f b+  plate f (Mul a b) = Mul <$> f a <*> f b+  plate f (Div a b) = Div <$> f a <*> f b+  plate _ t = pure t+  {-# INLINE plate #-}++-- | ndm's uniplate+instance Uni.Uniplate Expr where+  uniplate (Neg a)   = Uni.plate Neg |* a+  uniplate (Add a b) = Uni.plate Add |* a |* b+  uniplate (Sub a b) = Uni.plate Sub |* a |* b+  uniplate (Mul a b) = Uni.plate Mul |* a |* b+  uniplate (Div a b) = Uni.plate Div |* a |* b+  uniplate (Val i)   = Uni.plate (Val i)+  uniplate (Var s)   = Uni.plate (Var s)+  {-# INLINE uniplate #-}++main :: IO ()+main = defaultMain+  [ bench "universe"                           $ nf (map universe) testsExpr+  , bench "universeOf plate"                   $ nf (map (universeOf plate)) testsExpr+  , bench "universeOf Generic.tinplate"        $ nf (map (universeOf Generic.tinplate)) testsExpr+  , bench "universeOf Data.tinplate"           $ nf (map (universeOf Data.tinplate)) testsExpr+  , bench "universeOf Data.template"           $ nf (map (universeOf Data.template)) testsExpr+  , bench "universeOf Data.uniplate"           $ nf (map (universeOf Data.uniplate)) testsExpr+  , bench "universeOf (cloneTraversal plate)"  $ nf (map (universeOf (cloneTraversal plate))) testsExpr+  , bench "Direct.universe"                    $ nf (map Uni.universe) testsExpr+  , bench "DataOnly.universe"                  $ nf (map UniDataOnly.universe) testsExpr+  ]++testsExpr :: [Expr]+testsExpr = [Val 3,Val 2,Val 6,Neg (Neg (Var "dus")),Mul (Div (Add (Val 4) (Var "kxm")) (Sub (Mul (Div (Var "") (Var "")) (Var "w")) (Var "ed"))) (Var "whpd"),Val 6,Val 4,Val 2,Var "a",Val 1,Div (Var "") (Val 0),Var "",Var "",Val (-3),Val 3,Sub (Var "") (Val 2),Neg (Var "dlp"),Div (Val 0) (Var "sd"),Val (-2),Val (-3),Var "g",Mul (Val 3) (Var "i"),Val 1,Var "ul",Div (Add (Var "") (Var "")) (Mul (Div (Val 0) (Neg (Val 0))) (Neg (Neg (Mul (Var "") (Val 0))))),Var "z",Sub (Neg (Add (Var "") (Val 0))) (Var ""),Neg (Sub (Mul (Val 0) (Val 2)) (Val 5)),Val 0,Val 0,Mul (Val (-4)) (Sub (Val 5) (Neg (Div (Div (Val 0) (Sub (Neg (Sub (Val (-3)) (Mul (Mul (Var "ap") (Val 3)) (Add (Add (Add (Var "owre") (Add (Add (Var "avj") (Val 3)) (Var "vhi"))) (Mul (Val 2) (Var "hak"))) (Val 2))))) (Var "nf"))) (Add (Sub (Val 5) (Sub (Var "pkjyh") (Val 2))) (Var "lsiu"))))),Var "u",Val 1,Neg (Add (Add (Var "") (Val 1)) (Sub (Add (Add (Val (-3)) (Mul (Val 1) (Var "pfe"))) (Var "yv")) (Mul (Var "") (Var "jfq")))),Val 2,Div (Div (Div (Div (Var "xrgykq") (Mul (Var "kyfu") (Val 2))) (Sub (Var "v") (Val 0))) (Sub (Val 6) (Val 2))) (Val 3),Var "",Var "",Add (Var "ob") (Sub (Mul (Neg (Val 2)) (Val 6)) (Add (Mul (Val 6) (Sub (Add (Var "wue") (Mul (Var "hgsuj") (Neg (Div (Var "hr") (Var "ozvsb"))))) (Sub (Var "j") (Div (Var "yeyhvq") (Val (-6)))))) (Var "b"))),Div (Add (Div (Div (Neg (Val 4)) (Var "")) (Var "yfx")) (Div (Sub (Var "") (Sub (Var "np") (Mul (Val 3) (Var "mxr")))) (Mul (Var "m") (Var "kkhbf")))) (Neg (Sub (Var "yie") (Val 1))),Neg (Var ""),Var "liuh",Var "pbqg",Var "",Neg (Div (Sub (Add (Val (-1)) (Var "onynvr")) (Neg (Var "tqjsay"))) (Add (Val 4) (Var "yorkb"))),Val 1,Add (Mul (Neg (Div (Val (-1)) (Var "u"))) (Sub (Var "") (Neg (Val 1)))) (Var "h"),Var "",Add (Mul (Sub (Var "em") (Val 0)) (Add (Val (-2)) (Val 1))) (Var ""),Add (Mul (Add (Div (Add (Val 0) (Mul (Mul (Var "e") (Add (Val 1) (Var ""))) (Neg (Neg (Div (Add (Div (Neg (Val 1)) (Div (Val (-1)) (Mul (Add (Div (Val (-1)) (Mul (Mul (Val 1) (Val 1)) (Mul (Var "t") (Val (-1))))) (Val 1)) (Val 1)))) (Add (Neg (Add (Val 0) (Var "k"))) (Mul (Neg (Div (Sub (Sub (Var "u") (Val 1)) (Val 1)) (Sub (Neg (Var "")) (Sub (Var "b") (Val (-1)))))) (Neg (Var ""))))) (Val 0)))))) (Val 0)) (Var "a")) (Var "")) (Val (-1)),Var "xijsnp",Div (Var "h") (Neg (Val 5)),Div (Var "dmzlh") (Add (Val 6) (Val (-2))),Neg (Add (Val 0) (Var "")),Add (Add (Add (Sub (Val 4) (Var "nfse")) (Var "o")) (Add (Val 2) (Div (Var "mtqdx") (Val (-3))))) (Val 3),Neg (Var "c"),Var "sr",Mul (Add (Sub (Neg (Val 1)) (Sub (Div (Add (Sub (Add (Sub (Sub (Var "gd") (Mul (Var "v") (Var "d"))) (Var "")) (Val 1)) (Add (Val 2) (Var ""))) (Var "kk")) (Div (Var "fw") (Add (Val 1) (Var "f")))) (Var ""))) (Val 2)) (Add (Neg (Div (Var "") (Val 0))) (Add (Var "") (Add (Var "s") (Add (Mul (Var "") (Val (-1))) (Val 1))))),Val 1,Var "",Sub (Var "vbnzahx") (Val (-5)),Var "nl",Val 0,Add (Mul (Neg (Mul (Var "") (Var "mvil"))) (Var "")) (Neg (Var "zxl")),Val (-3),Var "",Var "e",Add (Div (Sub (Val 0) (Add (Val 5) (Val 7))) (Mul (Var "") (Var "qz"))) (Val 4),Add (Val (-1)) (Neg (Var "lk")),Add (Add (Var "u") (Mul (Val 1) (Var "h"))) (Sub (Mul (Div (Val 1) (Div (Var "t") (Neg (Var "")))) (Var "")) (Mul (Val 1) (Neg (Div (Neg (Var "")) (Var ""))))),Val 0,Val 0,Val (-7),Mul (Var "") (Val 0),Mul (Add (Val (-6)) (Add (Val 2) (Sub (Div (Var "z") (Var "gbb")) (Var "vddnpsl")))) (Add (Add (Add (Var "") (Sub (Div (Val 3) (Neg (Div (Add (Var "cfvgz") (Add (Sub (Var "htd") (Sub (Var "mhbl") (Var "un"))) (Val 3))) (Val (-3))))) (Var ""))) (Val 5)) (Neg (Mul (Val 0) (Var "sufvvj")))),Sub (Div (Neg (Add (Add (Neg (Add (Var "") (Val 0))) (Var "")) (Sub (Val 0) (Val 0)))) (Val 0)) (Add (Neg (Div (Div (Add (Sub (Add (Add (Neg (Var "")) (Val 0)) (Val 0)) (Add (Neg (Add (Neg (Var "")) (Neg (Val 0)))) (Val 0))) (Div (Val 0) (Val 0))) (Val 0)) (Val 0))) (Var "")),Var "",Sub (Div (Val 0) (Div (Add (Val 1) (Neg (Div (Neg (Var "y")) (Val 0)))) (Var ""))) (Sub (Div (Var "t") (Var "")) (Neg (Var "s"))),Mul (Div (Sub (Var "") (Var "")) (Add (Val 0) (Sub (Div (Var "yr") (Neg (Var "o"))) (Val 1)))) (Var "u"),Var "odmn",Div (Var "uddqy") (Val 3),Var "",Sub (Val 2) (Neg (Val (-1))),Div (Mul (Var "sox") (Val (-3))) (Val (-3)),Var "qv",Var "xmbnts",Var "j",Mul (Val 6) (Mul (Var "fryndq") (Neg (Val 6))),Var "",Var "",Val (-1),Val 7,Add (Var "dg") (Val 1),Neg (Val 1),Val 0,Var "xnm",Sub (Div (Div (Var "miwi") (Var "mbh")) (Val 3)) (Val 3),Neg (Val (-4)),Var "ndubxoa",Var ""]
config view
@@ -3,7 +3,7 @@ -- This is particularly useful for travis-ci to get it to stop complaining -- about a broken build when everything is still correct on our end. ----- This uses Luite Stegman's mirror of hackage provided by his 'hdiff' site instead+-- This uses Luite Stegeman's mirror of hackage provided by his 'hdiff' site instead -- -- To enable this, uncomment the before_script in .travis.yml
+ examples/Plates.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE MultiParamTypeClasses, DeriveGeneric, DeriveDataTypeable #-}+import Control.Applicative+import Control.Lens+import GHC.Generics+import Data.Data+import Data.Data.Lens++data Expr = Var Int | Pos Expr String | Neg Expr | Add Expr Expr deriving (Eq,Ord,Show,Read,Generic,Data,Typeable)+data Stmt = Seq [Stmt] | Sel [Expr] | Let String Expr deriving (Eq,Ord,Show,Read,Generic,Data,Typeable)++instance Plated Expr where+  plate f (Var x  ) = pure (Var x)+  plate f (Pos x y) = Pos <$> f x <*> pure y+  plate f (Neg x  ) = Neg <$> f x+  plate f (Add x y) = Add <$> f x <*> f y++instance Plated Stmt where+  plate f (Seq xs) = Seq <$> traverse f xs+  plate f (Sel xs) = pure (Sel xs)+  plate f (Let x y) = pure (Let x y)++exprs :: Simple Traversal Stmt Expr+exprs f (Seq xs)  = Seq <$> traverse (exprs f) xs+exprs f (Sel xs)  = Sel <$> traverse f xs+exprs f (Let x y) = Let x <$> f y
+ examples/Pong.hs view
@@ -0,0 +1,233 @@+{-# LANGUAGE TemplateHaskell, Rank2Types, NoMonomorphismRestriction #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Main+-- Copyright   :  (C) 2012 Edward Kmett, nand`+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  TH, Rank2, NoMonomorphismRestriction+--+-- A simple game of pong using gloss.+-----------------------------------------------------------------------------+module Main where++import Control.Applicative ((<$>), (<*>))+import Control.Lens+import Control.Monad.State (State, execState, get)+import Control.Monad (when)++import Data.Set (Set, member, empty, insert, delete)++import Graphics.Gloss+import Graphics.Gloss.Interface.Pure.Game++import System.Random (randomRs, getStdGen)++-- Some global constants++gameSize        = 300+windowWidth     = 800+windowHeight    = 600+ballRadius      = 0.02+speedIncrease   = 1.2+losingAccuracy  = 0.9+winningAccuracy = 0.1+initialSpeed    = 0.6+paddleWidth     = 0.02+paddleHeight    = 0.3+paddleSpeed     = 1+textSize        = 0.001++-- Pure data type for representing the game state++data Pong = Pong+  { _ballPos   :: Point+  , _ballSpeed :: Vector+  , _paddle1   :: Float+  , _paddle2   :: Float+  , _score     :: (Int, Int)+  , _vectors   :: [Vector]++  -- Since gloss doesn't cover this, we store the set of pressed keys+  , _keys      :: Set Key+  }++-- Some nice lenses to go with it+makeLenses ''Pong++-- Renamed tuple lenses for enhanced clarity with points/vectors+_x = _1+_y = _2++initial :: Pong+initial = Pong (0, 0) (0, 0) 0 0 (0, 0) [] empty++-- Calculate the y position at which the ball will next hit (on player2's side)+hitPos :: Point -> Vector -> Float+hitPos (x,y) (u,v) = ypos+  where+    xdist = if u >= 0 then 1 - x else 3 + x+    time  = xdist / abs u+    ydist = v * time+    ypos  = bounce (y + ydist)+    o     = 1 - ballRadius++    -- Calculate bounces iteratively+    bounce n+      | n >  o    = bounce (  2 *o - n)+      | n < -o    = bounce ((-2)*o - n)+      | otherwise = n++-- Difficulty function+accuracy :: Pong -> Float+accuracy p = g . f . fromIntegral $ p^.score._1 - p^.score._2+  where+    -- Scaling function+    f x = 0.04 * x + 0.5+    -- Clamping function+    g = min losingAccuracy . max winningAccuracy++-- Game update logic++update :: Float -> Pong -> Pong+update time = execState $ do+  updatePaddles time+  updateBall time+  checkBounds++-- Move the ball by adding its current speed+updateBall :: Float -> State Pong ()+updateBall time = do+  (u, v) <- use ballSpeed+  ballPos += (time * u, time * v)++  -- Make sure it doesn't leave the playing area+  ballPos.both %= clamp ballRadius++-- Update the paddles+updatePaddles :: Float -> State Pong ()+updatePaddles time = do+  p <- get++  let paddleMovement = time * paddleSpeed+      keyPressed key = p^.keys.contains (SpecialKey key)++  -- Update the player's paddle based on keys+  when (keyPressed KeyUp)   $ paddle1 += paddleMovement+  when (keyPressed KeyDown) $ paddle1 -= paddleMovement++  -- Calculate the optimal position+  let optimal = hitPos (p^.ballPos) (p^.ballSpeed)+      acc     = accuracy p+      target  = optimal * acc + (p^.ballPos._y) * (1 - acc)+      dist    = target - p^.paddle2++  -- Move the CPU's paddle towards this optimal position as needed+  when (abs dist > paddleHeight/3) $+    case compare dist 0 of+      GT -> paddle2 += paddleMovement+      LT -> paddle2 -= paddleMovement+      _  -> return ()++  -- Make sure both paddles don't leave the playing area+  paddle1 %= clamp (paddleHeight/2)+  paddle2 %= clamp (paddleHeight/2)++-- Clamp to the region (-1, 1) but with padding+clamp :: Float -> Float -> Float+clamp pad = max (pad - 1) . min (1 - pad)++-- Check for collisions and/or scores+checkBounds :: State Pong ()+checkBounds = do+  p <- get+  let (x,y) = p^.ballPos++  -- Check for collisions with the top or bottom+  when (abs y >= edge) $+    ballSpeed._y %= negate++  -- Check for collisions with paddles+  let check paddle other+        | y >= p^.paddle - paddleHeight/2 && y <= p^.paddle + paddleHeight/2 = do+            ballSpeed._x   %= negate+            ballSpeed._y   += 3*(y - p^.paddle) -- add english+            ballSpeed.both *= speedIncrease+        | otherwise = do+          score.other += 1+          reset++  when (x >=  edge) $ check paddle2 _1+  when (x <= -edge) $ check paddle1 _2++  where+    edge = 1 - ballRadius++-- Reset the game+reset :: State Pong ()+reset = do+  ballPos .= (0, 0)+  ballSpeed <~ nextSpeed++-- Retrieve a speed from the list, dropping it in the process+nextSpeed :: State Pong Vector+nextSpeed = do+  v:vs <- use vectors+  vectors .= vs+  return v++-- Drawing a pong state to the screen++draw :: Pong -> Picture+draw p = scale gameSize gameSize $ Pictures+  [ drawBall   `at` p^.ballPos+  , drawPaddle `at` (-paddleX, p^.paddle1)+  , drawPaddle `at` ( paddleX, p^.paddle2)++  -- Score and playing field+  , drawScore (p^.score) `at` (-0.1, 0.85)+  , rectangleWire 2 2+  ]+  where+    paddleX = 1 + paddleWidth/2+    p `at` (x,y) = translate x y p; infixr 1 `at`++drawPaddle :: Picture+drawPaddle = rectangleSolid paddleWidth paddleHeight++drawBall :: Picture+drawBall = circleSolid ballRadius++drawScore :: (Int, Int) -> Picture+drawScore (x, y) = scale textSize textSize . text $ show x ++ " " ++ show y++-- Handle input by simply updating the keys set++handle :: Event -> Pong -> Pong+handle (EventKey k s _ _) = keys.contains k .~ (s == Down)+handle _ = id++-- The main program action++main = do+  v:vs <- startingSpeeds+  let world = ballSpeed .~ v $ vectors .~ vs $ initial+  play display backColor fps world draw handle update++  where+    display   = InWindow "Pong!" (windowWidth, windowHeight) (200, 200)+    backColor = white+    fps       = 120++-- Generate the random list of starting speeds++startingSpeeds :: IO [Vector]+startingSpeeds = do+  rs <- randomRs (-initialSpeed, initialSpeed) <$> getStdGen+  return . interleave $ filter ((> 0.2) . abs) rs++  where+    interleave :: [a] -> [(a,a)]+    interleave (x:y:xs) = (x,y) : interleave xs+    interleave _        = []
examples/lens-examples.cabal view
@@ -25,7 +25,7 @@     base       == 4.*,     containers >= 0.4.2 && < 0.6,     gloss      == 1.7.*,-    lens       == 1.7.*,+    lens,     mtl        >= 2.0.1 && < 2.2,     random     == 1.0.*-  main-is: pong.hs+  main-is: Pong.hs
− examples/pong.hs 
@@ -1,235 +0,0 @@-{-# LANGUAGE TemplateHaskell, Rank2Types, NoMonomorphismRestriction #-}--------------------------------------------------------------------------------- |--- Module      :  Main--- Copyright   :  (C) 2012 Edward Kmett, nand`--- License     :  BSD-style (see the file LICENSE)--- Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  provisional--- Portability :  TH, Rank2, NoMonomorphismRestriction------ A simple game of pong using gloss.-------------------------------------------------------------------------------module Main where--import Control.Applicative ((<$>), (<*>))-import Control.Lens-import Control.Monad.State (State, execState, get)-import Control.Monad (when)--import Data.Set (Set, member, empty, insert, delete)-import Data.Set.Lens (contains)-import Data.Pair.Lens (both)--import Graphics.Gloss-import Graphics.Gloss.Interface.Pure.Game--import System.Random (randomRs, getStdGen)---- Some global constants--gameSize        = 300-windowWidth     = 800-windowHeight    = 600-ballRadius      = 0.02-speedIncrease   = 1.2-losingAccuracy  = 0.9-winningAccuracy = 0.1-initialSpeed    = 0.6-paddleWidth     = 0.02-paddleHeight    = 0.3-paddleSpeed     = 1-textSize        = 0.001---- Pure data type for representing the game state--data Pong = Pong-  { _ballPos   :: Point-  , _ballSpeed :: Vector-  , _paddle1   :: Float-  , _paddle2   :: Float-  , _score     :: (Int, Int)-  , _vectors   :: [Vector]--  -- Since gloss doesn't cover this, we store the set of pressed keys-  , _keys      :: Set Key-  }---- Some nice lenses to go with it-makeLenses ''Pong---- Renamed tuple lenses for enhanced clarity with points/vectors-_x = _1-_y = _2--initial :: Pong-initial = Pong (0, 0) (0, 0) 0 0 (0, 0) [] empty---- Calculate the y position at which the ball will next hit (on player2's side)-hitPos :: Point -> Vector -> Float-hitPos (x,y) (u,v) = ypos-  where-    xdist = if u >= 0 then 1 - x else 3 + x-    time  = xdist / abs u-    ydist = v * time-    ypos  = bounce (y + ydist)-    o     = 1 - ballRadius--    -- Calculate bounces iteratively-    bounce n-      | n >  o    = bounce (  2 *o - n)-      | n < -o    = bounce ((-2)*o - n)-      | otherwise = n---- Difficulty function-accuracy :: Pong -> Float-accuracy p = g . f . fromIntegral $ p^.score._1 - p^.score._2-  where-    -- Scaling function-    f x = 0.04 * x + 0.5-    -- Clamping function-    g = min losingAccuracy . max winningAccuracy---- Game update logic--update :: Float -> Pong -> Pong-update time = execState $ do-  updatePaddles time-  updateBall time-  checkBounds---- Move the ball by adding its current speed-updateBall :: Float -> State Pong ()-updateBall time = do-  (u, v) <- use ballSpeed-  ballPos += (time * u, time * v)--  -- Make sure it doesn't leave the playing area-  ballPos.both %= clamp ballRadius---- Update the paddles-updatePaddles :: Float -> State Pong ()-updatePaddles time = do-  p <- get--  let paddleMovement = time * paddleSpeed-      keyPressed key = p^.keys.contains (SpecialKey key)--  -- Update the player's paddle based on keys-  when (keyPressed KeyUp)   $ paddle1 += paddleMovement-  when (keyPressed KeyDown) $ paddle1 -= paddleMovement--  -- Calculate the optimal position-  let optimal = hitPos (p^.ballPos) (p^.ballSpeed)-      acc     = accuracy p-      target  = optimal * acc + (p^.ballPos._y) * (1 - acc)-      dist    = target - p^.paddle2--  -- Move the CPU's paddle towards this optimal position as needed-  when (abs dist > paddleHeight/3) $-    case compare dist 0 of-      GT -> paddle2 += paddleMovement-      LT -> paddle2 -= paddleMovement-      _  -> return ()--  -- Make sure both paddles don't leave the playing area-  paddle1 %= clamp (paddleHeight/2)-  paddle2 %= clamp (paddleHeight/2)---- Clamp to the region (-1, 1) but with padding-clamp :: Float -> Float -> Float-clamp pad = max (pad - 1) . min (1 - pad)---- Check for collisions and/or scores-checkBounds :: State Pong ()-checkBounds = do-  p <- get-  let (x,y) = p^.ballPos--  -- Check for collisions with the top or bottom-  when (abs y >= edge) $-    ballSpeed._y %= negate--  -- Check for collisions with paddles-  let check paddle other-        | y >= p^.paddle - paddleHeight/2 && y <= p^.paddle + paddleHeight/2 = do-            ballSpeed._x   %= negate-            ballSpeed._y   += 3*(y - p^.paddle) -- add english-            ballSpeed.both *= speedIncrease-        | otherwise = do-          score.other += 1-          reset--  when (x >=  edge) $ check paddle2 _1-  when (x <= -edge) $ check paddle1 _2--  where-    edge = 1 - ballRadius---- Reset the game-reset :: State Pong ()-reset = do-  ballPos .= (0, 0)-  ballSpeed <~ nextSpeed---- Retrieve a speed from the list, dropping it in the process-nextSpeed :: State Pong Vector-nextSpeed = do-  v:vs <- use vectors-  vectors .= vs-  return v---- Drawing a pong state to the screen--draw :: Pong -> Picture-draw p = scale gameSize gameSize $ Pictures-  [ drawBall   `at` p^.ballPos-  , drawPaddle `at` (-paddleX, p^.paddle1)-  , drawPaddle `at` ( paddleX, p^.paddle2)--  -- Score and playing field-  , drawScore (p^.score) `at` (-0.1, 0.85)-  , rectangleWire 2 2-  ]-  where-    paddleX = 1 + paddleWidth/2-    p `at` (x,y) = translate x y p; infixr 1 `at`--drawPaddle :: Picture-drawPaddle = rectangleSolid paddleWidth paddleHeight--drawBall :: Picture-drawBall = circleSolid ballRadius--drawScore :: (Int, Int) -> Picture-drawScore (x, y) = scale textSize textSize . text $ show x ++ " " ++ show y---- Handle input by simply updating the keys set--handle :: Event -> Pong -> Pong-handle (EventKey k s _ _) = keys.contains k .~ (s == Down)-handle _ = id---- The main program action--main = do-  v:vs <- startingSpeeds-  let world = ballSpeed .~ v $ vectors .~ vs $ initial-  play display backColor fps world draw handle update--  where-    display   = InWindow "Pong!" (windowWidth, windowHeight) (200, 200)-    backColor = white-    fps       = 120---- Generate the random list of starting speeds--startingSpeeds :: IO [Vector]-startingSpeeds = do-  rs <- randomRs (-initialSpeed, initialSpeed) <$> getStdGen-  return . interleave $ filter ((> 0.2) . abs) rs--  where-    interleave :: [a] -> [(a,a)]-    interleave (x:y:xs) = (x,y) : interleave xs-    interleave _        = []
lens.cabal view
@@ -1,6 +1,6 @@ name:          lens category:      Data, Lenses-version:       2.4.0.2+version:       2.5 license:       BSD3 cabal-version: >= 1.8 license-file:  LICENSE@@ -33,7 +33,7 @@   .   The core of this hierarchy looks like:   .-  <<https://github.com/ekmett/lens/wiki/images/Hierarchy-2.4.png>>+  <<https://github.com/ekmett/lens/wiki/images/Hierarchy-2.5.png>>   .   You can compose any two elements of the hierarchy above using (.) from the Prelude, and you can   use any element of the hierarchy as any type it links to above it.@@ -87,7 +87,8 @@   config   examples/LICENSE   examples/lens-examples.cabal-  examples/pong.hs+  examples/Pong.hs+  examples/Plates.hs   README.markdown   CHANGELOG.markdown @@ -97,47 +98,64 @@  library   build-depends:-    base             >= 4.3   && < 5,-    containers       >= 0.4.2 && < 0.6,-    mtl              >= 2.1.1 && < 2.2,-    template-haskell >= 2.4   && < 2.9,-    transformers     >= 0.3   && < 0.4+    base                 >= 4.3      && < 5,+    bytestring           >= 0.9.1.10 && < 0.11,+    comonad              == 3.0.*,+    comonad-transformers == 3.0.*,+    comonads-fd          == 3.0.*,+    containers           >= 0.4.2    && < 0.6,+    hashable             == 1.1.*,+    mtl                  >= 2.1.1    && < 2.2,+    template-haskell     >= 2.4      && < 2.9,+    text                 >= 0.11     && < 0.12,+    transformers         >= 0.3      && < 0.4,+    unordered-containers >= 0.2      && < 0.3 -  exposed-modules: Control.Exception.Lens-                   Control.Lens-                   Control.Lens.Action-                   Control.Lens.Fold-                   Control.Lens.Getter-                   Control.Lens.Indexed-                   Control.Lens.IndexedGetter-                   Control.Lens.IndexedFold-                   Control.Lens.IndexedLens-                   Control.Lens.IndexedSetter-                   Control.Lens.IndexedTraversal-                   Control.Lens.Internal-                   Control.Lens.Iso-                   Control.Lens.Isomorphic-                   Control.Lens.Representable-                   Control.Lens.Setter-                   Control.Lens.TH-                   Control.Lens.Traversal-                   Control.Lens.Tuple-                   Control.Lens.Type-                   Control.Lens.Zoom-                   Data.Bits.Lens-                   Data.Complex.Lens-                   Data.Dynamic.Lens-                   Data.Either.Lens-                   Data.List.Lens-                   Data.Pair.Lens-                   Data.IntMap.Lens-                   Data.IntSet.Lens-                   Data.Map.Lens-                   Data.Monoid.Lens-                   Data.Sequence.Lens-                   Data.Set.Lens-                   Data.Tree.Lens-                   Language.Haskell.TH.Lens+  exposed-modules:+    Control.Exception.Lens+    Control.Lens+    Control.Lens.Action+    Control.Lens.Fold+    Control.Lens.Getter+    Control.Lens.Indexed+    Control.Lens.IndexedGetter+    Control.Lens.IndexedFold+    Control.Lens.IndexedLens+    Control.Lens.IndexedSetter+    Control.Lens.IndexedTraversal+    Control.Lens.Internal+    Control.Lens.Iso+    Control.Lens.Isomorphic+    Control.Lens.Plated+    Control.Lens.Representable+    Control.Lens.Setter+    Control.Lens.TH+    Control.Lens.Traversal+    Control.Lens.Tuple+    Control.Lens.Type+    Control.Lens.WithIndex+    Control.Lens.Zoom+    Data.Bits.Lens+    Data.ByteString.Lens+    Data.ByteString.Strict.Lens+    Data.ByteString.Lazy.Lens+    Data.Complex.Lens+    Data.Data.Lens+    Data.Dynamic.Lens+    Data.HashSet.Lens+    Data.IntMap.Lens+    Data.IntSet.Lens+    Data.List.Lens+    Data.Map.Lens+    Data.Monoid.Lens+    Data.Sequence.Lens+    Data.Set.Lens+    Data.Text.Lens+    Data.Text.Strict.Lens+    Data.Text.Lazy.Lens+    Data.Tree.Lens+    Data.Typeable.Lens+    Language.Haskell.TH.Lens    -- platform   build-depends:   array >= 0.3.0.2 && < 0.5@@ -146,30 +164,11 @@   build-depends:   filepath >= 1.2.0.0 && < 1.4   exposed-modules: System.FilePath.Lens -  build-depends:   bytestring >= 0.9.1.10 && < 0.11-  exposed-modules: Data.ByteString.Lens Data.ByteString.Lazy.Lens--  build-depends:   text >= 0.11.1.5 && < 0.12-  exposed-modules: Data.Text.Lens Data.Text.Lazy.Lens-   build-depends:   parallel >= 3.1.0.1 && < 3.3   exposed-modules: Control.Parallel.Strategies.Lens Control.Seq.Lens -  other-extensions:-    BangPatterns-    CPP-    DeriveDataTypeable-    FlexibleContexts-    FlexibleInstances-    FunctionalDependencies-    LiberalTypeSynonyms-    MultiParamTypeClasses-    Rank2Types-    RankNTypes-    TemplateHaskell-    TypeFamilies-    TypeOperators-    UndecidableInstances+  if impl(ghc>7.6.0.20120810)+    cpp-options: -DNEW_INLINE_PRAGMAS    if (impl(ghc>=7.4))     other-extensions: Trustworthy@@ -196,7 +195,7 @@   type: exitcode-stdio-1.0   main-is: templates.hs   build-depends:-    base == 4.*,+    base,     lens   ghc-options: -Wall -Werror -threaded   hs-source-dirs: tests@@ -206,9 +205,25 @@   type: exitcode-stdio-1.0   main-is: properties.hs   build-depends:-    base         == 4.*,+    base,     lens,     QuickCheck   >= 2.4 && < 2.6,     transformers >= 0.3 && < 0.5   ghc-options: -w -threaded   hs-source-dirs: tests++-- Basic benchmarks for the uniplate-style combinators+benchmark plated+  type: exitcode-stdio-1.0+  main-is: plated.hs+  build-depends:+    base,+    comonad,+    criterion,+    deepseq,+    ghc-prim,+    lens,+    transformers,+    uniplate >= 1.6.7 && < 1.7+  ghc-options: -Wall -O2 -threaded+  hs-source-dirs: benchmarks
src/Control/Lens.hs view
@@ -41,7 +41,7 @@ -- -- <http://github.com/ekmett/lens/wiki> ----- <<http://github.com/ekmett/lens/wiki/images/Hierarchy-2.4.png>>+-- <<http://github.com/ekmett/lens/wiki/images/Hierarchy-2.5.png>> ---------------------------------------------------------------------------- module Control.Lens   ( module Control.Lens.Type@@ -57,26 +57,30 @@   , module Control.Lens.IndexedLens   , module Control.Lens.IndexedTraversal   , module Control.Lens.IndexedSetter+  , module Control.Lens.Plated   , module Control.Lens.Representable   , module Control.Lens.TH   , module Control.Lens.Tuple+  , module Control.Lens.WithIndex   , module Control.Lens.Zoom   ) where -import Control.Lens.Type-import Control.Lens.Traversal-import Control.Lens.Getter-import Control.Lens.Setter import Control.Lens.Action import Control.Lens.Fold-import Control.Lens.Iso+import Control.Lens.Getter import Control.Lens.Indexed import Control.Lens.IndexedFold import Control.Lens.IndexedGetter import Control.Lens.IndexedLens-import Control.Lens.IndexedTraversal import Control.Lens.IndexedSetter+import Control.Lens.IndexedTraversal+import Control.Lens.Iso+import Control.Lens.Plated import Control.Lens.Representable+import Control.Lens.Setter import Control.Lens.TH-import Control.Lens.Zoom+import Control.Lens.Traversal import Control.Lens.Tuple+import Control.Lens.Type+import Control.Lens.WithIndex+import Control.Lens.Zoom
src/Control/Lens/Fold.hs view
@@ -37,6 +37,7 @@   (   -- * Folds     Fold+  , (^?), (^..)   -- ** Building Folds   --, folds   , folding@@ -71,6 +72,8 @@   , foldrOf', foldlOf'   , foldr1Of, foldl1Of   , foldrMOf, foldlMOf+  -- * Storing Folds+  , ReifiedFold(..)   ) where  import Control.Applicative as Applicative@@ -83,6 +86,7 @@ import Data.Maybe import Data.Monoid +infixl 8 ^?, ^..  -------------------------- -- Folds@@ -114,6 +118,7 @@ folding afc cgd = coerce . traverse_ cgd . afc {-# INLINE folding #-} + -- | A monoid in a monad as a monoid newtype GA f a = GA { getGA :: f a } @@ -222,11 +227,11 @@ -- @'foldMapOf' = 'views'@ -- -- @--- foldMapOf ::             'Getter' a c           -> (c -> r) -> a -> r--- foldMapOf :: 'Monoid' r => 'Fold' a c             -> (c -> r) -> a -> r--- foldMapOf ::             'Simple' 'Lens' a c      -> (c -> r) -> a -> r--- foldMapOf ::             'Simple' 'Control.Lens.Iso.Iso' a c       -> (c -> r) -> a -> r--- foldMapOf :: 'Monoid' r => 'Simple' 'Control.Lens.Traversal.Traversal' a c -> (c -> r) -> a -> r+-- 'foldMapOf' ::             'Getter' a c           -> (c -> r) -> a -> r+-- 'foldMapOf' :: 'Monoid' r => 'Fold' a c             -> (c -> r) -> a -> r+-- 'foldMapOf' ::             'Simple' 'Lens' a c      -> (c -> r) -> a -> r+-- 'foldMapOf' ::             'Simple' 'Control.Lens.Iso.Iso' a c       -> (c -> r) -> a -> r+-- 'foldMapOf' :: 'Monoid' r => 'Simple' 'Control.Lens.Traversal.Traversal' a c -> (c -> r) -> a -> r -- @ foldMapOf :: Getting r a c -> (c -> r) -> a -> r foldMapOf l f = runAccessor . l (Accessor . f)@@ -238,11 +243,11 @@ -- @'foldOf' = 'view'@ -- -- @--- foldOf ::             'Getter' a m           -> a -> m--- foldOf :: 'Monoid' m => 'Fold' a m             -> a -> m--- foldOf ::             'Simple' 'Lens' a m      -> a -> m--- foldOf ::             'Simple' 'Control.Lens.Iso.Iso' a m       -> a -> m--- foldOf :: 'Monoid' m => 'Simple' 'Control.Lens.Traversal.Traversal' a m -> a -> m+-- 'foldOf' ::             'Getter' a m           -> a -> m+-- 'foldOf' :: 'Monoid' m => 'Fold' a m             -> a -> m+-- 'foldOf' ::             'Simple' 'Lens' a m      -> a -> m+-- 'foldOf' ::             'Simple' 'Control.Lens.Iso.Iso' a m       -> a -> m+-- 'foldOf' :: 'Monoid' m => 'Simple' 'Control.Lens.Traversal.Traversal' a m -> a -> m -- @ foldOf :: Getting c a c -> a -> c foldOf l = runAccessor . l Accessor@@ -254,11 +259,11 @@ -- @'Data.Foldable.foldr' = 'foldrOf' 'folded'@ -- -- @--- foldrOf :: 'Getter' a c           -> (c -> e -> e) -> e -> a -> e--- foldrOf :: 'Fold' a c             -> (c -> e -> e) -> e -> a -> e--- foldrOf :: 'Simple' 'Lens' a c      -> (c -> e -> e) -> e -> a -> e--- foldrOf :: 'Simple' 'Control.Lens.Iso.Iso' a c       -> (c -> e -> e) -> e -> a -> e--- foldrOf :: 'Simple' 'Control.Lens.Traversal.Traversal' a c -> (c -> e -> e) -> e -> a -> e+-- 'foldrOf' :: 'Getter' a c           -> (c -> e -> e) -> e -> a -> e+-- 'foldrOf' :: 'Fold' a c             -> (c -> e -> e) -> e -> a -> e+-- 'foldrOf' :: 'Simple' 'Lens' a c      -> (c -> e -> e) -> e -> a -> e+-- 'foldrOf' :: 'Simple' 'Control.Lens.Iso.Iso' a c       -> (c -> e -> e) -> e -> a -> e+-- 'foldrOf' :: 'Simple' 'Control.Lens.Traversal.Traversal' a c -> (c -> e -> e) -> e -> a -> e -- @ foldrOf :: Getting (Endo e) a c -> (c -> e -> e) -> e -> a -> e foldrOf l f z t = appEndo (foldMapOf l (Endo . f) t) z@@ -270,39 +275,55 @@ -- @'Data.Foldable.foldl' = 'foldlOf' 'folded'@ -- -- @--- foldlOf :: 'Getter' a c           -> (e -> c -> e) -> e -> a -> e--- foldlOf :: 'Fold' a c             -> (e -> c -> e) -> e -> a -> e--- foldlOf :: 'Simple' 'Lens' a c      -> (e -> c -> e) -> e -> a -> e--- foldlOf :: 'Simple' 'Control.Lens.Iso.Iso' a c       -> (e -> c -> e) -> e -> a -> e--- foldlOf :: 'Simple' 'Control.Lens.Traversal.Traversal' a c -> (e -> c -> e) -> e -> a -> e+-- 'foldlOf' :: 'Getter' a c           -> (e -> c -> e) -> e -> a -> e+-- 'foldlOf' :: 'Fold' a c             -> (e -> c -> e) -> e -> a -> e+-- 'foldlOf' :: 'Simple' 'Lens' a c      -> (e -> c -> e) -> e -> a -> e+-- 'foldlOf' :: 'Simple' 'Control.Lens.Iso.Iso' a c       -> (e -> c -> e) -> e -> a -> e+-- 'foldlOf' :: 'Simple' 'Control.Lens.Traversal.Traversal' a c -> (e -> c -> e) -> e -> a -> e -- @ foldlOf :: Getting (Dual (Endo e)) a c -> (e -> c -> e) -> e -> a -> e foldlOf l f z t = appEndo (getDual (foldMapOf l (Dual . Endo . flip f) t)) z {-# INLINE foldlOf #-} --- |--- @'Data.Foldable.toList' = 'toListOf' 'folded'@+-- | Extract a list of the targets of a 'Fold'. See also ('^..'). -- -- @--- toListOf :: 'Getter' a c           -> a -> [c]--- toListOf :: 'Fold' a c             -> a -> [c]--- toListOf :: 'Simple' 'Lens' a c      -> a -> [c]--- toListOf :: 'Simple' 'Control.Lens.Iso.Iso' a c       -> a -> [c]--- toListOf :: 'Simple' 'Control.Lens.Traversal.Traversal' a c -> a -> [c]+-- 'Data.Foldable.toList' = 'toListOf' 'folded'+-- ('^..') = 'flip' 'toListOf' -- @+--+-- @+-- 'toListOf' :: 'Getter' a c           -> a -> [c]+-- 'toListOf' :: 'Fold' a c             -> a -> [c]+-- 'toListOf' :: 'Simple' 'Lens' a c      -> a -> [c]+-- 'toListOf' :: 'Simple' 'Control.Lens.Iso.Iso' a c       -> a -> [c]+-- 'toListOf' :: 'Simple' 'Control.Lens.Traversal.Traversal' a c -> a -> [c]+-- @ toListOf :: Getting [c] a c -> a -> [c] toListOf l = foldMapOf l return {-# INLINE toListOf #-} +-- | A convenient infix (flipped) version of 'toListOf'.+--+-- @+-- 'toListOf' :: a -> 'Getter' a c           -> [c]+-- 'toListOf' :: a -> 'Fold' a c             -> [c]+-- 'toListOf' :: a -> 'Simple' 'Lens' a c      -> [c]+-- 'toListOf' :: a -> 'Simple' 'Control.Lens.Iso.Iso' a c       -> [c]+-- 'toListOf' :: a -> 'Simple' 'Control.Lens.Traversal.Traversal' a c -> [c]+-- @+(^..) :: a -> Getting [c] a c -> [c]+a ^.. l = foldMapOf l return a+ -- | -- @'Data.Foldable.and' = 'andOf' 'folded'@ -- -- @--- andOf :: 'Getter' a 'Bool'           -> a -> 'Bool'--- andOf :: 'Fold' a 'Bool'             -> a -> 'Bool'--- andOf :: 'Simple' 'Lens' a 'Bool'      -> a -> 'Bool'--- andOf :: 'Simple' 'Control.Lens.Iso.Iso' a 'Bool'       -> a -> 'Bool'--- andOf :: 'Simple' 'Control.Lens.Traversal.Traversal' a 'Bool' -> a -> 'Bool'+-- 'andOf' :: 'Getter' a 'Bool'           -> a -> 'Bool'+-- 'andOf' :: 'Fold' a 'Bool'             -> a -> 'Bool'+-- 'andOf' :: 'Simple' 'Lens' a 'Bool'      -> a -> 'Bool'+-- 'andOf' :: 'Simple' 'Control.Lens.Iso.Iso' a 'Bool'       -> a -> 'Bool'+-- 'andOf' :: 'Simple' 'Control.Lens.Traversal.Traversal' a 'Bool' -> a -> 'Bool' -- @ andOf :: Getting All a Bool -> a -> Bool andOf l = getAll . foldMapOf l All@@ -312,11 +333,11 @@ -- @'Data.Foldable.or' = 'orOf' 'folded'@ -- -- @--- orOf :: 'Getter' a 'Bool'           -> a -> 'Bool'--- orOf :: 'Fold' a 'Bool'             -> a -> 'Bool'--- orOf :: 'Simple' 'Lens' a 'Bool'      -> a -> 'Bool'--- orOf :: 'Simple' 'Control.Lens.Iso.Iso' a 'Bool'       -> a -> 'Bool'--- orOf :: 'Simple' 'Control.Lens.Traversal.Traversal' a 'Bool' -> a -> 'Bool'+-- 'orOf' :: 'Getter' a 'Bool'           -> a -> 'Bool'+-- 'orOf' :: 'Fold' a 'Bool'             -> a -> 'Bool'+-- 'orOf' :: 'Simple' 'Lens' a 'Bool'      -> a -> 'Bool'+-- 'orOf' :: 'Simple' 'Control.Lens.Iso.Iso' a 'Bool'       -> a -> 'Bool'+-- 'orOf' :: 'Simple' 'Control.Lens.Traversal.Traversal' a 'Bool' -> a -> 'Bool' -- @ orOf :: Getting Any a Bool -> a -> Bool orOf l = getAny . foldMapOf l Any@@ -326,11 +347,11 @@ -- @'Data.Foldable.any' = 'anyOf' 'folded'@ -- -- @--- anyOf :: 'Getter' a c               -> (c -> 'Bool') -> a -> 'Bool'--- anyOf :: 'Fold' a c                 -> (c -> 'Bool') -> a -> 'Bool'--- anyOf :: 'Simple' 'Lens' a b c d      -> (c -> 'Bool') -> a -> 'Bool'--- anyOf :: 'Simple' 'Control.Lens.Iso.Iso' a b c d       -> (c -> 'Bool') -> a -> 'Bool'--- anyOf :: 'Simple' 'Control.Lens.Traversal.Traversal' a b c d -> (c -> 'Bool') -> a -> 'Bool'+-- 'anyOf' :: 'Getter' a c               -> (c -> 'Bool') -> a -> 'Bool'+-- 'anyOf' :: 'Fold' a c                 -> (c -> 'Bool') -> a -> 'Bool'+-- 'anyOf' :: 'Simple' 'Lens' a b c d      -> (c -> 'Bool') -> a -> 'Bool'+-- 'anyOf' :: 'Simple' 'Control.Lens.Iso.Iso' a b c d       -> (c -> 'Bool') -> a -> 'Bool'+-- 'anyOf' :: 'Simple' 'Control.Lens.Traversal.Traversal' a b c d -> (c -> 'Bool') -> a -> 'Bool' -- @ anyOf :: Getting Any a c -> (c -> Bool) -> a -> Bool anyOf l f = getAny . foldMapOf l (Any . f)@@ -340,11 +361,11 @@ -- @'Data.Foldable.all' = 'allOf' 'folded'@ -- -- @--- allOf :: 'Getter' a c           -> (c -> 'Bool') -> a -> 'Bool'--- allOf :: 'Fold' a c             -> (c -> 'Bool') -> a -> 'Bool'--- allOf :: 'Simple' 'Lens' a c      -> (c -> 'Bool') -> a -> 'Bool'--- allOf :: 'Simple' 'Control.Lens.Iso.Iso' a c       -> (c -> 'Bool') -> a -> 'Bool'--- allOf :: 'Simple' 'Control.Lens.Traversal.Traversal' a c -> (c -> 'Bool') -> a -> 'Bool'+-- 'allOf' :: 'Getter' a c           -> (c -> 'Bool') -> a -> 'Bool'+-- 'allOf' :: 'Fold' a c             -> (c -> 'Bool') -> a -> 'Bool'+-- 'allOf' :: 'Simple' 'Lens' a c      -> (c -> 'Bool') -> a -> 'Bool'+-- 'allOf' :: 'Simple' 'Control.Lens.Iso.Iso' a c       -> (c -> 'Bool') -> a -> 'Bool'+-- 'allOf' :: 'Simple' 'Control.Lens.Traversal.Traversal' a c -> (c -> 'Bool') -> a -> 'Bool' -- @ allOf :: Getting All a c -> (c -> Bool) -> a -> Bool allOf l f = getAll . foldMapOf l (All . f)@@ -354,11 +375,11 @@ -- @'Data.Foldable.product' = 'productOf' 'folded'@ -- -- @--- productOf ::          'Getter' a c           -> a -> c--- productOf :: 'Num' c => 'Fold' a c             -> a -> c--- productOf ::          'Simple' 'Lens' a c      -> a -> c--- productOf ::          'Simple' 'Control.Lens.Iso.Iso' a c       -> a -> c--- productOf :: 'Num' c => 'Simple' 'Control.Lens.Traversal.Traversal' a c -> a -> c+-- 'productOf' ::          'Getter' a c           -> a -> c+-- 'productOf' :: 'Num' c => 'Fold' a c             -> a -> c+-- 'productOf' ::          'Simple' 'Lens' a c      -> a -> c+-- 'productOf' ::          'Simple' 'Control.Lens.Iso.Iso' a c       -> a -> c+-- 'productOf' :: 'Num' c => 'Simple' 'Control.Lens.Traversal.Traversal' a c -> a -> c -- @ productOf :: Getting (Product c) a c -> a -> c productOf l = getProduct . foldMapOf l Product@@ -372,11 +393,11 @@ -- @'sumOf' ('folded' . '_1') :: ('Foldable' f, 'Num' a) => f (a, b) -> a@ -- -- @--- sumOf ::          'Getter' a c           -> a -> c--- sumOf :: 'Num' c => 'Fold' a c             -> a -> c--- sumOf ::          'Simple' 'Lens' a c      -> a -> c--- sumOf ::          'Simple' 'Control.Lens.Iso.Iso' a c       -> a -> c--- sumOf :: 'Num' c => 'Simple' 'Control.Lens.Traversal.Traversal' a c -> a -> c+-- 'sumOf' ::          'Getter' a c           -> a -> c+-- 'sumOf' :: 'Num' c => 'Fold' a c             -> a -> c+-- 'sumOf' ::          'Simple' 'Lens' a c      -> a -> c+-- 'sumOf' ::          'Simple' 'Control.Lens.Iso.Iso' a c       -> a -> c+-- 'sumOf' :: 'Num' c => 'Simple' 'Control.Lens.Traversal.Traversal' a c -> a -> c -- @ sumOf :: Getting (Sum c) a c -> a -> c sumOf l = getSum . foldMapOf l Sum@@ -397,11 +418,11 @@ -- The rather specific signature of traverseOf_ allows it to be used as if the signature was either: -- -- @--- traverseOf_ :: 'Functor' f     => 'Getter' a c           -> (c -> f e) -> a -> f ()--- traverseOf_ :: 'Applicative' f => 'Fold' a c             -> (c -> f e) -> a -> f ()--- traverseOf_ :: 'Functor' f     => 'Simple' 'Lens' a c      -> (c -> f e) -> a -> f ()--- traverseOf_ :: 'Functor' f     => 'Simple' 'Control.Lens.Iso.Iso' a c       -> (c -> f e) -> a -> f ()--- traverseOf_ :: 'Applicative' f => 'Simple' 'Control.Lens.Traversal.Traversal' a c -> (c -> f e) -> a -> f ()+-- 'traverseOf_' :: 'Functor' f     => 'Getter' a c           -> (c -> f e) -> a -> f ()+-- 'traverseOf_' :: 'Applicative' f => 'Fold' a c             -> (c -> f e) -> a -> f ()+-- 'traverseOf_' :: 'Functor' f     => 'Simple' 'Lens' a c      -> (c -> f e) -> a -> f ()+-- 'traverseOf_' :: 'Functor' f     => 'Simple' 'Control.Lens.Iso.Iso' a c       -> (c -> f e) -> a -> f ()+-- 'traverseOf_' :: 'Applicative' f => 'Simple' 'Control.Lens.Traversal.Traversal' a c -> (c -> f e) -> a -> f () -- @ traverseOf_ :: Functor f => Getting (Traversed f) a c -> (c -> f e) -> a -> f () traverseOf_ l f = getTraversed . foldMapOf l (Traversed . void . f)@@ -411,11 +432,11 @@ -- @'for_' = 'forOf_' 'folded'@ -- -- @--- forOf_ :: 'Functor' f     => 'Getter' a c           -> a -> (c -> f e) -> f ()--- forOf_ :: 'Applicative' f => 'Fold' a c             -> a -> (c -> f e) -> f ()--- forOf_ :: 'Functor' f     => 'Simple' 'Lens' a c      -> a -> (c -> f e) -> f ()--- forOf_ :: 'Functor' f     => 'Simple' 'Control.Lens.Iso.Iso' a c       -> a -> (c -> f e) -> f ()--- forOf_ :: 'Applicative' f => 'Simple' 'Control.Lens.Traversal.Traversal' a c -> a -> (c -> f e) -> f ()+-- 'forOf_' :: 'Functor' f     => 'Getter' a c           -> a -> (c -> f e) -> f ()+-- 'forOf_' :: 'Applicative' f => 'Fold' a c             -> a -> (c -> f e) -> f ()+-- 'forOf_' :: 'Functor' f     => 'Simple' 'Lens' a c      -> a -> (c -> f e) -> f ()+-- 'forOf_' :: 'Functor' f     => 'Simple' 'Control.Lens.Iso.Iso' a c       -> a -> (c -> f e) -> f ()+-- 'forOf_' :: 'Applicative' f => 'Simple' 'Control.Lens.Traversal.Traversal' a c -> a -> (c -> f e) -> f () -- @ forOf_ :: Functor f => Getting (Traversed f) a c -> a -> (c -> f e) -> f () forOf_ = flip . traverseOf_@@ -425,11 +446,11 @@ -- @'sequenceA_' = 'sequenceAOf_' 'folded'@ -- -- @--- sequenceAOf_ :: 'Functor' f     => 'Getter' a (f ())           -> a -> f ()--- sequenceAOf_ :: 'Applicative' f => 'Fold' a (f ())             -> a -> f ()--- sequenceAOf_ :: 'Functor' f     => 'Simple' 'Lens' a (f ())      -> a -> f ()--- sequenceAOf_ :: 'Functor' f     => 'Simple' 'Iso' a (f ())       -> a -> f ()--- sequenceAOf_ :: 'Applicative' f => 'Simple' 'Control.Lens.Traversal.Traversal' a (f ()) -> a -> f ()+-- 'sequenceAOf_' :: 'Functor' f     => 'Getter' a (f ())           -> a -> f ()+-- 'sequenceAOf_' :: 'Applicative' f => 'Fold' a (f ())             -> a -> f ()+-- 'sequenceAOf_' :: 'Functor' f     => 'Simple' 'Lens' a (f ())      -> a -> f ()+-- 'sequenceAOf_' :: 'Functor' f     => 'Simple' 'Iso' a (f ())       -> a -> f ()+-- 'sequenceAOf_' :: 'Applicative' f => 'Simple' 'Control.Lens.Traversal.Traversal' a (f ()) -> a -> f () -- @ sequenceAOf_ :: Functor f => Getting (Traversed f) a (f ()) -> a -> f () sequenceAOf_ l = getTraversed . foldMapOf l (Traversed . void)@@ -439,11 +460,11 @@ -- @'Data.Foldable.mapM_' = 'mapMOf_' 'folded'@ -- -- @--- mapMOf_ :: 'Monad' m => 'Getter' a c           -> (c -> m e) -> a -> m ()--- mapMOf_ :: 'Monad' m => 'Fold' a c             -> (c -> m e) -> a -> m ()--- mapMOf_ :: 'Monad' m => 'Simple' 'Lens' a c      -> (c -> m e) -> a -> m ()--- mapMOf_ :: 'Monad' m => 'Simple' 'Control.Lens.Iso.Iso' a c       -> (c -> m e) -> a -> m ()--- mapMOf_ :: 'Monad' m => 'Simple' 'Control.Lens.Traversal.Traversal' a c -> (c -> m e) -> a -> m ()+-- 'mapMOf_' :: 'Monad' m => 'Getter' a c           -> (c -> m e) -> a -> m ()+-- 'mapMOf_' :: 'Monad' m => 'Fold' a c             -> (c -> m e) -> a -> m ()+-- 'mapMOf_' :: 'Monad' m => 'Simple' 'Lens' a c      -> (c -> m e) -> a -> m ()+-- 'mapMOf_' :: 'Monad' m => 'Simple' 'Control.Lens.Iso.Iso' a c       -> (c -> m e) -> a -> m ()+-- 'mapMOf_' :: 'Monad' m => 'Simple' 'Control.Lens.Traversal.Traversal' a c -> (c -> m e) -> a -> m () -- @ mapMOf_ :: Monad m => Getting (Sequenced m) a c -> (c -> m e) -> a -> m () mapMOf_ l f = getSequenced . foldMapOf l (Sequenced . liftM skip . f)@@ -457,11 +478,11 @@ -- @'Data.Foldable.forM_' = 'forMOf_' 'folded'@ -- -- @--- forMOf_ :: 'Monad' m => 'Getter' a c           -> a -> (c -> m e) -> m ()--- forMOf_ :: 'Monad' m => 'Fold' a c             -> a -> (c -> m e) -> m ()--- forMOf_ :: 'Monad' m => 'Simple' 'Lens' a c      -> a -> (c -> m e) -> m ()--- forMOf_ :: 'Monad' m => 'Simple' 'Control.Lens.Iso.Iso' a c       -> a -> (c -> m e) -> m ()--- forMOf_ :: 'Monad' m => 'Simple' 'Control.Lens.Traversal.Traversal' a c -> a -> (c -> m e) -> m ()+-- 'forMOf_' :: 'Monad' m => 'Getter' a c           -> a -> (c -> m e) -> m ()+-- 'forMOf_' :: 'Monad' m => 'Fold' a c             -> a -> (c -> m e) -> m ()+-- 'forMOf_' :: 'Monad' m => 'Simple' 'Lens' a c      -> a -> (c -> m e) -> m ()+-- 'forMOf_' :: 'Monad' m => 'Simple' 'Control.Lens.Iso.Iso' a c       -> a -> (c -> m e) -> m ()+-- 'forMOf_' :: 'Monad' m => 'Simple' 'Control.Lens.Traversal.Traversal' a c -> a -> (c -> m e) -> m () -- @ forMOf_ :: Monad m => Getting (Sequenced m) a c -> a -> (c -> m e) -> m () forMOf_ = flip . mapMOf_@@ -471,11 +492,11 @@ -- @'Data.Foldable.sequence_' = 'sequenceOf_' 'folded'@ -- -- @--- sequenceOf_ :: 'Monad' m => 'Getter' a (m b)           -> a -> m ()--- sequenceOf_ :: 'Monad' m => 'Fold' a (m b)             -> a -> m ()--- sequenceOf_ :: 'Monad' m => 'Simple' 'Lens' a (m b)      -> a -> m ()--- sequenceOf_ :: 'Monad' m => 'Simple' 'Control.Lens.Iso.Iso' a (m b)       -> a -> m ()--- sequenceOf_ :: 'Monad' m => 'Simple' 'Control.Lens.Traversal.Traversal' a (m b) -> a -> m ()+-- 'sequenceOf_' :: 'Monad' m => 'Getter' a (m b)           -> a -> m ()+-- 'sequenceOf_' :: 'Monad' m => 'Fold' a (m b)             -> a -> m ()+-- 'sequenceOf_' :: 'Monad' m => 'Simple' 'Lens' a (m b)      -> a -> m ()+-- 'sequenceOf_' :: 'Monad' m => 'Simple' 'Control.Lens.Iso.Iso' a (m b)       -> a -> m ()+-- 'sequenceOf_' :: 'Monad' m => 'Simple' 'Control.Lens.Traversal.Traversal' a (m b) -> a -> m () -- @ sequenceOf_ :: Monad m => Getting (Sequenced m) a (m c) -> a -> m () sequenceOf_ l = getSequenced . foldMapOf l (Sequenced . liftM skip)@@ -486,11 +507,11 @@ -- @'asum' = 'asumOf' 'folded'@ -- -- @--- asumOf :: 'Alternative' f => 'Getter' a c           -> a -> f c--- asumOf :: 'Alternative' f => 'Fold' a c             -> a -> f c--- asumOf :: 'Alternative' f => 'Simple' 'Lens' a c      -> a -> f c--- asumOf :: 'Alternative' f => 'Simple' 'Control.Lens.Iso.Iso' a c       -> a -> f c--- asumOf :: 'Alternative' f => 'Simple' 'Control.Lens.Traversal.Traversal' a c -> a -> f c+-- 'asumOf' :: 'Alternative' f => 'Getter' a c           -> a -> f c+-- 'asumOf' :: 'Alternative' f => 'Fold' a c             -> a -> f c+-- 'asumOf' :: 'Alternative' f => 'Simple' 'Lens' a c      -> a -> f c+-- 'asumOf' :: 'Alternative' f => 'Simple' 'Control.Lens.Iso.Iso' a c       -> a -> f c+-- 'asumOf' :: 'Alternative' f => 'Simple' 'Control.Lens.Traversal.Traversal' a c -> a -> f c -- @ asumOf :: Alternative f => Getting (Endo (f c)) a (f c) -> a -> f c asumOf l = foldrOf l (<|>) Applicative.empty@@ -501,11 +522,11 @@ -- @'msum' = 'msumOf' 'folded'@ -- -- @--- msumOf :: 'MonadPlus' m => 'Getter' a c           -> a -> m c--- msumOf :: 'MonadPlus' m => 'Fold' a c             -> a -> m c--- msumOf :: 'MonadPlus' m => 'Simple' 'Lens' a c      -> a -> m c--- msumOf :: 'MonadPlus' m => 'Simple' 'Control.Lens.Iso.Iso' a c       -> a -> m c--- msumOf :: 'MonadPlus' m => 'Simple' 'Control.Lens.Traversal.Traversal' a c -> a -> m c+-- 'msumOf' :: 'MonadPlus' m => 'Getter' a c           -> a -> m c+-- 'msumOf' :: 'MonadPlus' m => 'Fold' a c             -> a -> m c+-- 'msumOf' :: 'MonadPlus' m => 'Simple' 'Lens' a c      -> a -> m c+-- 'msumOf' :: 'MonadPlus' m => 'Simple' 'Control.Lens.Iso.Iso' a c       -> a -> m c+-- 'msumOf' :: 'MonadPlus' m => 'Simple' 'Control.Lens.Traversal.Traversal' a c -> a -> m c -- @ msumOf :: MonadPlus m => Getting (Endo (m c)) a (m c) -> a -> m c msumOf l = foldrOf l mplus mzero@@ -515,11 +536,11 @@ -- @'elem' = 'elemOf' 'folded'@ -- -- @--- elemOf :: 'Eq' c => 'Getter' a c           -> c -> a -> 'Bool'--- elemOf :: 'Eq' c => 'Fold' a c             -> c -> a -> 'Bool'--- elemOf :: 'Eq' c => 'Simple' 'Lens' a c      -> c -> a -> 'Bool'--- elemOf :: 'Eq' c => 'Simple' 'Control.Lens.Iso.Iso' a c       -> c -> a -> 'Bool'--- elemOf :: 'Eq' c => 'Simple' 'Control.Lens.Traversal.Traversal' a c -> c -> a -> 'Bool'+-- 'elemOf' :: 'Eq' c => 'Getter' a c           -> c -> a -> 'Bool'+-- 'elemOf' :: 'Eq' c => 'Fold' a c             -> c -> a -> 'Bool'+-- 'elemOf' :: 'Eq' c => 'Simple' 'Lens' a c      -> c -> a -> 'Bool'+-- 'elemOf' :: 'Eq' c => 'Simple' 'Control.Lens.Iso.Iso' a c       -> c -> a -> 'Bool'+-- 'elemOf' :: 'Eq' c => 'Simple' 'Control.Lens.Traversal.Traversal' a c -> c -> a -> 'Bool' -- @ elemOf :: Eq c => Getting Any a c -> c -> a -> Bool elemOf l = anyOf l . (==)@@ -529,11 +550,11 @@ -- @'notElem' = 'notElemOf' 'folded'@ -- -- @--- notElemOf :: 'Eq' c => 'Getter' a c           -> c -> a -> 'Bool'--- notElemOf :: 'Eq' c => 'Fold' a c             -> c -> a -> 'Bool'--- notElemOf :: 'Eq' c => 'Simple' 'Control.Lens.Iso.Iso' a c       -> c -> a -> 'Bool'--- notElemOf :: 'Eq' c => 'Simple' 'Lens' a c      -> c -> a -> 'Bool'--- notElemOf :: 'Eq' c => 'Simple' 'Control.Lens.Traversal.Traversal' a c -> c -> a -> 'Bool'+-- 'notElemOf' :: 'Eq' c => 'Getter' a c           -> c -> a -> 'Bool'+-- 'notElemOf' :: 'Eq' c => 'Fold' a c             -> c -> a -> 'Bool'+-- 'notElemOf' :: 'Eq' c => 'Simple' 'Control.Lens.Iso.Iso' a c       -> c -> a -> 'Bool'+-- 'notElemOf' :: 'Eq' c => 'Simple' 'Lens' a c      -> c -> a -> 'Bool'+-- 'notElemOf' :: 'Eq' c => 'Simple' 'Control.Lens.Traversal.Traversal' a c -> c -> a -> 'Bool' -- @ notElemOf :: Eq c => Getting All a c -> c -> a -> Bool notElemOf l = allOf l . (/=)@@ -543,11 +564,11 @@ -- @'concatMap' = 'concatMapOf' 'folded'@ -- -- @--- concatMapOf :: 'Getter' a c           -> (c -> [e]) -> a -> [e]--- concatMapOf :: 'Fold' a c             -> (c -> [e]) -> a -> [e]--- concatMapOf :: 'Simple' 'Lens' a c      -> (c -> [e]) -> a -> [e]--- concatMapOf :: 'Simple' 'Control.Lens.Iso.Iso' a c       -> (c -> [e]) -> a -> [e]--- concatMapOf :: 'Simple' 'Control.Lens.Traversal.Traversal' a c -> (c -> [e]) -> a -> [e]+-- 'concatMapOf' :: 'Getter' a c           -> (c -> [e]) -> a -> [e]+-- 'concatMapOf' :: 'Fold' a c             -> (c -> [e]) -> a -> [e]+-- 'concatMapOf' :: 'Simple' 'Lens' a c      -> (c -> [e]) -> a -> [e]+-- 'concatMapOf' :: 'Simple' 'Control.Lens.Iso.Iso' a c       -> (c -> [e]) -> a -> [e]+-- 'concatMapOf' :: 'Simple' 'Control.Lens.Traversal.Traversal' a c -> (c -> [e]) -> a -> [e] -- @ concatMapOf :: Getting [e] a c -> (c -> [e]) -> a -> [e] concatMapOf l ces = runAccessor . l (Accessor . ces)@@ -560,11 +581,11 @@ -- @ -- -- @--- concatOf :: 'Getter' a [e]           -> a -> [e]--- concatOf :: 'Fold' a [e]             -> a -> [e]--- concatOf :: 'Simple' 'Control.Lens.Iso.Iso' a [e]       -> a -> [e]--- concatOf :: 'Simple' 'Lens' a [e]      -> a -> [e]--- concatOf :: 'Simple' 'Control.Lens.Traversal.Traversal' a [e] -> a -> [e]+-- 'concatOf' :: 'Getter' a [e]           -> a -> [e]+-- 'concatOf' :: 'Fold' a [e]             -> a -> [e]+-- 'concatOf' :: 'Simple' 'Control.Lens.Iso.Iso' a [e]       -> a -> [e]+-- 'concatOf' :: 'Simple' 'Lens' a [e]      -> a -> [e]+-- 'concatOf' :: 'Simple' 'Control.Lens.Traversal.Traversal' a [e] -> a -> [e] -- @ concatOf :: Getting [e] a [e] -> a -> [e] concatOf = view@@ -582,41 +603,60 @@ -- @'lengthOf' ('folded' . 'folded') :: 'Foldable' f => f (g a) -> 'Int'@ -- -- @--- lengthOf :: 'Getter' a c           -> a -> 'Int'--- lengthOf :: 'Fold' a c             -> a -> 'Int'--- lengthOf :: 'Simple' 'Lens' a c      -> a -> 'Int'--- lengthOf :: 'Simple' 'Control.Lens.Iso.Iso' a c       -> a -> 'Int'--- lengthOf :: 'Simple' 'Control.Lens.Traversal.Traversal' a c -> a -> 'Int'+-- 'lengthOf' :: 'Getter' a c           -> a -> 'Int'+-- 'lengthOf' :: 'Fold' a c             -> a -> 'Int'+-- 'lengthOf' :: 'Simple' 'Lens' a c      -> a -> 'Int'+-- 'lengthOf' :: 'Simple' 'Control.Lens.Iso.Iso' a c       -> a -> 'Int'+-- 'lengthOf' :: 'Simple' 'Control.Lens.Traversal.Traversal' a c -> a -> 'Int' -- @ lengthOf :: Getting (Sum Int) a c -> a -> Int lengthOf l = getSum . foldMapOf l (\_ -> Sum 1) {-# INLINE lengthOf #-}  -- | Perform a safe 'head' of a 'Fold' or 'Control.Lens.Traversal.Traversal' or retrieve 'Just' the result--- from a 'Getter' or 'Lens'.+-- from a 'Getter' or 'Lens'. See also ('^?'). -- -- @'Data.Maybe.listToMaybe' . 'toList' = 'headOf' 'folded'@ -- -- @--- headOf :: 'Getter' a c           -> a -> 'Maybe' c--- headOf :: 'Fold' a c             -> a -> 'Maybe' c--- headOf :: 'Simple' 'Lens' a c      -> a -> 'Maybe' c--- headOf :: 'Simple' 'Control.Lens.Iso.Iso' a c       -> a -> 'Maybe' c--- headOf :: 'Simple' 'Control.Lens.Traversal.Traversal' a c -> a -> 'Maybe' c+-- 'headOf' :: 'Getter' a c           -> a -> 'Maybe' c+-- 'headOf' :: 'Fold' a c             -> a -> 'Maybe' c+-- 'headOf' :: 'Simple' 'Lens' a c      -> a -> 'Maybe' c+-- 'headOf' :: 'Simple' 'Control.Lens.Iso.Iso' a c       -> a -> 'Maybe' c+-- 'headOf' :: 'Simple' 'Control.Lens.Traversal.Traversal' a c -> a -> 'Maybe' c -- @ headOf :: Getting (First c) a c -> a -> Maybe c headOf l = getFirst . foldMapOf l (First . Just) {-# INLINE headOf #-} +-- | Perform a safe 'head' of a 'Fold' or 'Control.Lens.Traversal.Traversal' or retrieve 'Just' the result+-- from a 'Getter' or 'Lens'.+--+-- When using a 'Control.Lens.Traversal.Traversal' as a partial 'Control.Lens.Type.Lens', or a 'Fold' as a partial 'Getter' this can be a convenient+-- way to extract the optional value.+--+-- @('^?') = 'flip' 'headOf'@+--+-- @+-- ('^?') :: a -> 'Getter' a c           -> 'Maybe' c+-- ('^?') :: a -> 'Fold' a c             -> 'Maybe' c+-- ('^?') :: a -> 'Simple' 'Lens' a c      -> 'Maybe' c+-- ('^?') :: a -> 'Simple' 'Control.Lens.Iso.Iso' a c       -> 'Maybe' c+-- ('^?') :: a -> 'Simple' 'Control.Lens.Traversal.Traversal' a c -> 'Maybe' c+-- @+(^?) :: a -> Getting (First c) a c -> Maybe c+a ^? l = getFirst (foldMapOf l (First . Just) a)+{-# INLINE (^?) #-}+ -- | Perform a safe 'last' of a 'Fold' or 'Control.Lens.Traversal.Traversal' or retrieve 'Just' the result -- from a 'Getter' or 'Lens'. -- -- @--- lastOf :: 'Getter' a c           -> a -> 'Maybe' c--- lastOf :: 'Fold' a c             -> a -> 'Maybe' c--- lastOf :: 'Simple' 'Lens' a c      -> a -> 'Maybe' c--- lastOf :: 'Simple' 'Control.Lens.Iso.Iso' a c       -> a -> 'Maybe' c--- lastOf :: 'Simple' 'Control.Lens.Traversal.Traversal' a c -> a -> 'Maybe' c+-- 'lastOf' :: 'Getter' a c           -> a -> 'Maybe' c+-- 'lastOf' :: 'Fold' a c             -> a -> 'Maybe' c+-- 'lastOf' :: 'Simple' 'Lens' a c      -> a -> 'Maybe' c+-- 'lastOf' :: 'Simple' 'Control.Lens.Iso.Iso' a c       -> a -> 'Maybe' c+-- 'lastOf' :: 'Simple' 'Control.Lens.Traversal.Traversal' a c -> a -> 'Maybe' c -- @ lastOf :: Getting (Last c) a c -> a -> Maybe c lastOf l = getLast . foldMapOf l (Last . Just)@@ -638,11 +678,11 @@ -- @'nullOf' ('folded' . '_1' . 'folded') :: 'Foldable' f => f (g a, b) -> 'Bool'@ -- -- @--- nullOf :: 'Getter' a c           -> a -> 'Bool'--- nullOf :: 'Fold' a c             -> a -> 'Bool'--- nullOf :: 'Simple' 'Control.Lens.Iso.Iso' a c       -> a -> 'Bool'--- nullOf :: 'Simple' 'Lens' a c      -> a -> 'Bool'--- nullOf :: 'Simple' 'Control.Lens.Traversal.Traversal' a c -> a -> 'Bool'+-- 'nullOf' :: 'Getter' a c           -> a -> 'Bool'+-- 'nullOf' :: 'Fold' a c             -> a -> 'Bool'+-- 'nullOf' :: 'Simple' 'Control.Lens.Iso.Iso' a c       -> a -> 'Bool'+-- 'nullOf' :: 'Simple' 'Lens' a c      -> a -> 'Bool'+-- 'nullOf' :: 'Simple' 'Control.Lens.Traversal.Traversal' a c -> a -> 'Bool' -- @ nullOf :: Getting All a c -> a -> Bool nullOf l = getAll . foldMapOf l (\_ -> All False)@@ -656,11 +696,11 @@ -- @'maximum' = 'fromMaybe' ('error' "empty") . 'maximumOf' 'folded'@ -- -- @--- maximumOf ::          'Getter' a c           -> a -> 'Maybe' c--- maximumOf :: 'Ord' c => 'Fold' a c             -> a -> 'Maybe' c--- maximumOf ::          'Simple' 'Control.Lens.Iso.Iso' a c       -> a -> 'Maybe' c--- maximumOf ::          'Simple' 'Lens' a c      -> a -> 'Maybe' c--- maximumOf :: 'Ord' c => 'Simple' 'Control.Lens.Traversal.Traversal' a c -> a -> 'Maybe' c+-- 'maximumOf' ::          'Getter' a c           -> a -> 'Maybe' c+-- 'maximumOf' :: 'Ord' c => 'Fold' a c             -> a -> 'Maybe' c+-- 'maximumOf' ::          'Simple' 'Control.Lens.Iso.Iso' a c       -> a -> 'Maybe' c+-- 'maximumOf' ::          'Simple' 'Lens' a c      -> a -> 'Maybe' c+-- 'maximumOf' :: 'Ord' c => 'Simple' 'Control.Lens.Traversal.Traversal' a c -> a -> 'Maybe' c -- @ maximumOf :: Getting (Max c) a c -> a -> Maybe c maximumOf l = getMax . foldMapOf l Max@@ -674,11 +714,11 @@ -- @'minimum' = 'Data.Maybe.fromMaybe' ('error' "empty") . 'minimumOf' 'folded'@ -- -- @--- minimumOf ::          'Getter' a c           -> a -> 'Maybe' c--- minimumOf :: 'Ord' c => 'Fold' a c             -> a -> 'Maybe' c--- minimumOf ::          'Simple' 'Control.Lens.Iso.Iso' a c       -> a -> 'Maybe' c--- minimumOf ::          'Simple' 'Lens' a c      -> a -> 'Maybe' c--- minimumOf :: 'Ord' c => 'Simple' 'Control.Lens.Traversal.Traversal' a c -> a -> 'Maybe' c+-- 'minimumOf' ::          'Getter' a c           -> a -> 'Maybe' c+-- 'minimumOf' :: 'Ord' c => 'Fold' a c             -> a -> 'Maybe' c+-- 'minimumOf' ::          'Simple' 'Control.Lens.Iso.Iso' a c       -> a -> 'Maybe' c+-- 'minimumOf' ::          'Simple' 'Lens' a c      -> a -> 'Maybe' c+-- 'minimumOf' :: 'Ord' c => 'Simple' 'Control.Lens.Traversal.Traversal' a c -> a -> 'Maybe' c -- @ minimumOf :: Getting (Min c) a c -> a -> Maybe c minimumOf l = getMin . foldMapOf l Min@@ -691,11 +731,11 @@ -- @'Data.Foldable.maximumBy' cmp = 'Data.Maybe.fromMaybe' ('error' "empty") . 'maximumByOf' 'folded' cmp@ -- -- @--- maximumByOf :: 'Getter' a c           -> (c -> c -> 'Ordering') -> a -> 'Maybe' c--- maximumByOf :: 'Fold' a c             -> (c -> c -> 'Ordering') -> a -> 'Maybe' c--- maximumByOf :: 'Simple' 'Control.Lens.Iso.Iso' a c       -> (c -> c -> 'Ordering') -> a -> 'Maybe' c--- maximumByOf :: 'Simple' 'Lens' a c      -> (c -> c -> 'Ordering') -> a -> 'Maybe' c--- maximumByOf :: 'Simple' 'Control.Lens.Traversal.Traversal' a c -> (c -> c -> 'Ordering') -> a -> 'Maybe' c+-- 'maximumByOf' :: 'Getter' a c           -> (c -> c -> 'Ordering') -> a -> 'Maybe' c+-- 'maximumByOf' :: 'Fold' a c             -> (c -> c -> 'Ordering') -> a -> 'Maybe' c+-- 'maximumByOf' :: 'Simple' 'Control.Lens.Iso.Iso' a c       -> (c -> c -> 'Ordering') -> a -> 'Maybe' c+-- 'maximumByOf' :: 'Simple' 'Lens' a c      -> (c -> c -> 'Ordering') -> a -> 'Maybe' c+-- 'maximumByOf' :: 'Simple' 'Control.Lens.Traversal.Traversal' a c -> (c -> c -> 'Ordering') -> a -> 'Maybe' c -- @ maximumByOf :: Getting (Endo (Maybe c)) a c -> (c -> c -> Ordering) -> a -> Maybe c maximumByOf l cmp = foldrOf l step Nothing where@@ -710,11 +750,11 @@ -- > minimumBy cmp = fromMaybe (error "empty") . minimumByOf folded cmp -- -- @--- minimumByOf :: 'Getter' a c           -> (c -> c -> 'Ordering') -> a -> 'Maybe' c--- minimumByOf :: 'Fold' a c             -> (c -> c -> 'Ordering') -> a -> 'Maybe' c--- minimumByOf :: 'Simple' 'Control.Lens.Iso.Iso' a c       -> (c -> c -> 'Ordering') -> a -> 'Maybe' c--- minimumByOf :: 'Simple' 'Lens' a c      -> (c -> c -> 'Ordering') -> a -> 'Maybe' c--- minimumByOf :: 'Simple' 'Control.Lens.Traversal.Traversal' a c -> (c -> c -> 'Ordering') -> a -> 'Maybe' c+-- 'minimumByOf' :: 'Getter' a c           -> (c -> c -> 'Ordering') -> a -> 'Maybe' c+-- 'minimumByOf' :: 'Fold' a c             -> (c -> c -> 'Ordering') -> a -> 'Maybe' c+-- 'minimumByOf' :: 'Simple' 'Control.Lens.Iso.Iso' a c       -> (c -> c -> 'Ordering') -> a -> 'Maybe' c+-- 'minimumByOf' :: 'Simple' 'Lens' a c      -> (c -> c -> 'Ordering') -> a -> 'Maybe' c+-- 'minimumByOf' :: 'Simple' 'Control.Lens.Traversal.Traversal' a c -> (c -> c -> 'Ordering') -> a -> 'Maybe' c -- @ minimumByOf :: Getting (Endo (Maybe c)) a c -> (c -> c -> Ordering) -> a -> Maybe c minimumByOf l cmp = foldrOf l step Nothing where@@ -727,11 +767,11 @@ -- matching the predicate, or 'Nothing' if there is no such element. -- -- @--- findOf :: 'Getter' a c           -> (c -> 'Bool') -> a -> 'Maybe' c--- findOf :: 'Fold' a c             -> (c -> 'Bool') -> a -> 'Maybe' c--- findOf :: 'Simple' 'Control.Lens.Iso.Iso' a c       -> (c -> 'Bool') -> a -> 'Maybe' c--- findOf :: 'Simple' 'Lens' a c      -> (c -> 'Bool') -> a -> 'Maybe' c--- findOf :: 'Simple' 'Control.Lens.Traversal.Traversal' a c -> (c -> 'Bool') -> a -> 'Maybe' c+-- 'findOf' :: 'Getter' a c           -> (c -> 'Bool') -> a -> 'Maybe' c+-- 'findOf' :: 'Fold' a c             -> (c -> 'Bool') -> a -> 'Maybe' c+-- 'findOf' :: 'Simple' 'Control.Lens.Iso.Iso' a c       -> (c -> 'Bool') -> a -> 'Maybe' c+-- 'findOf' :: 'Simple' 'Lens' a c      -> (c -> 'Bool') -> a -> 'Maybe' c+-- 'findOf' :: 'Simple' 'Control.Lens.Traversal.Traversal' a c -> (c -> 'Bool') -> a -> 'Maybe' c -- @ findOf :: Getting (First c) a c -> (c -> Bool) -> a -> Maybe c findOf l p = getFirst . foldMapOf l step where@@ -750,11 +790,11 @@ -- @'Data.Foldable.foldr1' = 'foldr1Of' 'folded'@ -- -- @--- foldr1Of :: 'Getter' a c           -> (c -> c -> c) -> a -> c--- foldr1Of :: 'Fold' a c             -> (c -> c -> c) -> a -> c--- foldr1Of :: 'Simple' 'Control.Lens.Iso.Iso' a c       -> (c -> c -> c) -> a -> c--- foldr1Of :: 'Simple' 'Lens' a c      -> (c -> c -> c) -> a -> c--- foldr1Of :: 'Simple' 'Control.Lens.Traversal.Traversal' a c -> (c -> c -> c) -> a -> c+-- 'foldr1Of' :: 'Getter' a c           -> (c -> c -> c) -> a -> c+-- 'foldr1Of' :: 'Fold' a c             -> (c -> c -> c) -> a -> c+-- 'foldr1Of' :: 'Simple' 'Control.Lens.Iso.Iso' a c       -> (c -> c -> c) -> a -> c+-- 'foldr1Of' :: 'Simple' 'Lens' a c      -> (c -> c -> c) -> a -> c+-- 'foldr1Of' :: 'Simple' 'Control.Lens.Traversal.Traversal' a c -> (c -> c -> c) -> a -> c -- @ foldr1Of :: Getting (Endo (Maybe c)) a c -> (c -> c -> c) -> a -> c foldr1Of l f xs = fromMaybe (error "foldr1Of: empty structure")@@ -771,11 +811,11 @@ -- @'Data.Foldable.foldl1' = 'foldl1Of' 'folded'@ -- -- @--- foldl1Of :: 'Getter' a c           -> (c -> c -> c) -> a -> c--- foldl1Of :: 'Fold' a c             -> (c -> c -> c) -> a -> c--- foldl1Of :: 'Simple' 'Control.Lens.Iso.Iso' a c       -> (c -> c -> c) -> a -> c--- foldl1Of :: 'Simple' 'Lens' a c      -> (c -> c -> c) -> a -> c--- foldl1Of :: 'Simple' 'Control.Lens.Traversal.Traversal' a c -> (c -> c -> c) -> a -> c+-- 'foldl1Of' :: 'Getter' a c           -> (c -> c -> c) -> a -> c+-- 'foldl1Of' :: 'Fold' a c             -> (c -> c -> c) -> a -> c+-- 'foldl1Of' :: 'Simple' 'Control.Lens.Iso.Iso' a c       -> (c -> c -> c) -> a -> c+-- 'foldl1Of' :: 'Simple' 'Lens' a c      -> (c -> c -> c) -> a -> c+-- 'foldl1Of' :: 'Simple' 'Control.Lens.Traversal.Traversal' a c -> (c -> c -> c) -> a -> c -- @ foldl1Of :: Getting (Dual (Endo (Maybe c))) a c -> (c -> c -> c) -> a -> c foldl1Of l f xs = fromMaybe (error "foldl1Of: empty structure") (foldlOf l mf Nothing xs) where@@ -788,11 +828,11 @@ -- @'Data.Foldable.foldr'' = 'foldrOf'' 'folded'@ -- -- @--- foldrOf' :: 'Getter' a c           -> (c -> e -> e) -> e -> a -> e--- foldrOf' :: 'Fold' a c             -> (c -> e -> e) -> e -> a -> e--- foldrOf' :: 'Simple' 'Control.Lens.Iso.Iso' a c       -> (c -> e -> e) -> e -> a -> e--- foldrOf' :: 'Simple' 'Lens' a c      -> (c -> e -> e) -> e -> a -> e--- foldrOf' :: 'Simple' 'Control.Lens.Traversal.Traversal' a c -> (c -> e -> e) -> e -> a -> e+-- 'foldrOf'' :: 'Getter' a c           -> (c -> e -> e) -> e -> a -> e+-- 'foldrOf'' :: 'Fold' a c             -> (c -> e -> e) -> e -> a -> e+-- 'foldrOf'' :: 'Simple' 'Control.Lens.Iso.Iso' a c       -> (c -> e -> e) -> e -> a -> e+-- 'foldrOf'' :: 'Simple' 'Lens' a c      -> (c -> e -> e) -> e -> a -> e+-- 'foldrOf'' :: 'Simple' 'Control.Lens.Traversal.Traversal' a c -> (c -> e -> e) -> e -> a -> e -- @ foldrOf' :: Getting (Dual (Endo (e -> e))) a c -> (c -> e -> e) -> e -> a -> e foldrOf' l f z0 xs = foldlOf l f' id xs z0@@ -804,11 +844,11 @@ -- @'Data.Foldable.foldl'' = 'foldlOf'' 'folded'@ -- -- @--- foldlOf' :: 'Getter' a c           -> (e -> c -> e) -> e -> a -> e--- foldlOf' :: 'Fold' a c             -> (e -> c -> e) -> e -> a -> e--- foldlOf' :: 'Simple' 'Control.Lens.Iso.Iso' a c       -> (e -> c -> e) -> e -> a -> e--- foldlOf' :: 'Simple' 'Lens' a c      -> (e -> c -> e) -> e -> a -> e--- foldlOf' :: 'Simple' 'Control.Lens.Traversal.Traversal' a c -> (e -> c -> e) -> e -> a -> e+-- 'foldlOf'' :: 'Getter' a c           -> (e -> c -> e) -> e -> a -> e+-- 'foldlOf'' :: 'Fold' a c             -> (e -> c -> e) -> e -> a -> e+-- 'foldlOf'' :: 'Simple' 'Control.Lens.Iso.Iso' a c       -> (e -> c -> e) -> e -> a -> e+-- 'foldlOf'' :: 'Simple' 'Lens' a c      -> (e -> c -> e) -> e -> a -> e+-- 'foldlOf'' :: 'Simple' 'Control.Lens.Traversal.Traversal' a c -> (e -> c -> e) -> e -> a -> e -- @ foldlOf' :: Getting (Endo (e -> e)) a c -> (e -> c -> e) -> e -> a -> e foldlOf' l f z0 xs = foldrOf l f' id xs z0@@ -821,11 +861,11 @@ -- @'Data.Foldable.foldrM' = 'foldrMOf' 'folded'@ -- -- @--- foldrMOf :: 'Monad' m => 'Getter' a c           -> (c -> e -> m e) -> e -> a -> m e--- foldrMOf :: 'Monad' m => 'Fold' a c             -> (c -> e -> m e) -> e -> a -> m e--- foldrMOf :: 'Monad' m => 'Simple' 'Control.Lens.Iso.Iso' a c       -> (c -> e -> m e) -> e -> a -> m e--- foldrMOf :: 'Monad' m => 'Simple' 'Lens' a c      -> (c -> e -> m e) -> e -> a -> m e--- foldrMOf :: 'Monad' m => 'Simple' 'Control.Lens.Traversal.Traversal' a c -> (c -> e -> m e) -> e -> a -> m e+-- 'foldrMOf' :: 'Monad' m => 'Getter' a c           -> (c -> e -> m e) -> e -> a -> m e+-- 'foldrMOf' :: 'Monad' m => 'Fold' a c             -> (c -> e -> m e) -> e -> a -> m e+-- 'foldrMOf' :: 'Monad' m => 'Simple' 'Control.Lens.Iso.Iso' a c       -> (c -> e -> m e) -> e -> a -> m e+-- 'foldrMOf' :: 'Monad' m => 'Simple' 'Lens' a c      -> (c -> e -> m e) -> e -> a -> m e+-- 'foldrMOf' :: 'Monad' m => 'Simple' 'Control.Lens.Traversal.Traversal' a c -> (c -> e -> m e) -> e -> a -> m e -- @ foldrMOf :: Monad m          => Getting (Dual (Endo (e -> m e))) a c@@ -840,11 +880,11 @@ -- @'Data.Foldable.foldlM' = 'foldlMOf' 'folded'@ -- -- @--- foldlMOf :: 'Monad' m => 'Getter' a c           -> (e -> c -> m e) -> e -> a -> m e--- foldlMOf :: 'Monad' m => 'Fold' a c             -> (e -> c -> m e) -> e -> a -> m e--- foldlMOf :: 'Monad' m => 'Simple' 'Control.Lens.Iso.Iso' a c       -> (e -> c -> m e) -> e -> a -> m e--- foldlMOf :: 'Monad' m => 'Simple' 'Lens' a c      -> (e -> c -> m e) -> e -> a -> m e--- foldlMOf :: 'Monad' m => 'Simple' 'Control.Lens.Traversal.Traversal' a c -> (e -> c -> m e) -> e -> a -> m e+-- 'foldlMOf' :: 'Monad' m => 'Getter' a c           -> (e -> c -> m e) -> e -> a -> m e+-- 'foldlMOf' :: 'Monad' m => 'Fold' a c             -> (e -> c -> m e) -> e -> a -> m e+-- 'foldlMOf' :: 'Monad' m => 'Simple' 'Control.Lens.Iso.Iso' a c       -> (e -> c -> m e) -> e -> a -> m e+-- 'foldlMOf' :: 'Monad' m => 'Simple' 'Lens' a c      -> (e -> c -> m e) -> e -> a -> m e+-- 'foldlMOf' :: 'Monad' m => 'Simple' 'Control.Lens.Traversal.Traversal' a c -> (e -> c -> m e) -> e -> a -> m e -- @ foldlMOf :: Monad m          => Getting (Endo (e -> m e)) a c@@ -852,3 +892,6 @@ foldlMOf l f z0 xs = foldrOf l f' return xs z0   where f' x k z = f z x >>= k {-# INLINE foldlMOf #-}++-- | Useful for storing folds in containers.+newtype ReifiedFold a c = ReifyFold { reflectFold :: Fold a c }
src/Control/Lens/Getter.hs view
@@ -53,6 +53,9 @@   , uses   , query   , queries++  -- * Storing Getters+  , ReifiedGetter(..)   ) where  import Control.Lens.Internal@@ -123,11 +126,11 @@ -- signatures: -- -- @--- view ::             'Getter' a c             -> a -> c--- view :: 'Monoid' m => 'Control.Lens.Fold.Fold' a m               -> a -> m--- view ::             'Control.Lens.Type.Simple' 'Control.Lens.Iso.Iso' a c         -> a -> c--- view ::             'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a c        -> a -> c--- view :: 'Monoid' m => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a m   -> a -> m+-- 'view' ::             'Getter' a c             -> a -> c+-- 'view' :: 'Monoid' m => 'Control.Lens.Fold.Fold' a m               -> a -> m+-- 'view' ::             'Control.Lens.Type.Simple' 'Control.Lens.Iso.Iso' a c         -> a -> c+-- 'view' ::             'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a c        -> a -> c+-- 'view' :: 'Monoid' m => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a m   -> a -> m -- @ view :: Getting c a c -> a -> c view l = runAccessor . l Accessor@@ -146,11 +149,11 @@ -- 5 -- -- @--- views ::             'Getter' a c             -> (c -> d) -> a -> d--- views :: 'Monoid' m => 'Control.Lens.Fold.Fold' a c               -> (c -> m) -> a -> m--- views ::             'Control.Lens.Type.Simple' 'Control.Lens.Iso.Iso' a c         -> (c -> d) -> a -> d--- views ::             'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a c        -> (c -> d) -> a -> d--- views :: 'Monoid' m => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a c   -> (c -> m) -> a -> m+-- 'views' ::             'Getter' a c             -> (c -> d) -> a -> d+-- 'views' :: 'Monoid' m => 'Control.Lens.Fold.Fold' a c               -> (c -> m) -> a -> m+-- 'views' ::             'Control.Lens.Type.Simple' 'Control.Lens.Iso.Iso' a c         -> (c -> d) -> a -> d+-- 'views' ::             'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a c        -> (c -> d) -> a -> d+-- 'views' :: 'Monoid' m => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a c   -> (c -> m) -> a -> m -- @ views :: Getting m a c -> (c -> m) -> a -> m views l f = runAccessor . l (Accessor . f)@@ -168,11 +171,11 @@ -- "hello" -- -- @--- (^$) ::             'Getter' a c             -> a -> c--- (^$) :: 'Monoid' m => 'Control.Lens.Fold.Fold' a m               -> a -> m--- (^$) ::             'Control.Lens.Type.Simple' 'Control.Lens.Iso.Iso' a c         -> a -> c--- (^$) ::             'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a c        -> a -> c--- (^$) :: 'Monoid' m => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a m   -> a -> m+-- ('^$') ::             'Getter' a c             -> a -> c+-- ('^$') :: 'Monoid' m => 'Control.Lens.Fold.Fold' a m               -> a -> m+-- ('^$') ::             'Control.Lens.Type.Simple' 'Control.Lens.Iso.Iso' a c         -> a -> c+-- ('^$') ::             'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a c        -> a -> c+-- ('^$') :: 'Monoid' m => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a m   -> a -> m -- @ (^$) :: Getting c a c -> a -> c l ^$ a = runAccessor (l Accessor a)@@ -192,11 +195,11 @@ -- 2.23606797749979 -- -- @--- (^.) ::             a -> 'Getter' a c             -> c--- (^.) :: 'Monoid' m => a -> 'Control.Lens.Fold.Fold' a m               -> m--- (^.) ::             a -> 'Control.Lens.Type.Simple' 'Control.Lens.Iso.Iso' a c         -> c--- (^.) ::             a -> 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a c        -> c--- (^.) :: 'Monoid' m => a -> 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a m   -> m+-- ('^.') ::             a -> 'Getter' a c             -> c+-- ('^.') :: 'Monoid' m => a -> 'Control.Lens.Fold.Fold' a m               -> m+-- ('^.') ::             a -> 'Control.Lens.Type.Simple' 'Control.Lens.Iso.Iso' a c         -> c+-- ('^.') ::             a -> 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a c        -> c+-- ('^.') :: 'Monoid' m => a -> 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a m   -> m -- @ (^.) :: a -> Getting c a c -> c a ^. l = runAccessor (l Accessor a)@@ -213,11 +216,11 @@ -- to a monoidal value. -- -- @--- use :: 'MonadState' a m             => 'Getter' a c             -> m c--- use :: ('MonadState' a m, 'Monoid' r) => 'Control.Lens.Fold.Fold' a r               -> m r--- use :: 'MonadState' a m             => 'Control.Lens.Type.Simple' 'Control.Lens.Iso.Iso' a c         -> m c--- use :: 'MonadState' a m             => 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a c        -> m c--- use :: ('MonadState' a m, 'Monoid' r) => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a r   -> m r+-- 'use' :: 'MonadState' a m             => 'Getter' a c             -> m c+-- 'use' :: ('MonadState' a m, 'Monoid' r) => 'Control.Lens.Fold.Fold' a r               -> m r+-- 'use' :: 'MonadState' a m             => 'Control.Lens.Type.Simple' 'Control.Lens.Iso.Iso' a c         -> m c+-- 'use' :: 'MonadState' a m             => 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a c        -> m c+-- 'use' :: ('MonadState' a m, 'Monoid' r) => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a r   -> m r -- @ use :: MonadState a m => Getting c a c -> m c use l = State.gets (view l)@@ -230,11 +233,11 @@ -- points to a monoidal value. -- -- @--- uses :: 'MonadState' a m             => 'Getter' a c           -> (c -> e) -> m e--- uses :: ('MonadState' a m, 'Monoid' r) => 'Control.Lens.Fold.Fold' a c             -> (c -> r) -> m r--- uses :: 'MonadState' a m             => 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a c      -> (c -> e) -> m e--- uses :: 'MonadState' a m             => 'Control.Lens.Type.Simple' 'Control.Lens.Iso.Iso' a c       -> (c -> e) -> m e--- uses :: ('MonadState' a m, 'Monoid' r) => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a c -> (c -> r) -> m r+-- 'uses' :: 'MonadState' a m             => 'Getter' a c           -> (c -> e) -> m e+-- 'uses' :: ('MonadState' a m, 'Monoid' r) => 'Control.Lens.Fold.Fold' a c             -> (c -> r) -> m r+-- 'uses' :: 'MonadState' a m             => 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a c      -> (c -> e) -> m e+-- 'uses' :: 'MonadState' a m             => 'Control.Lens.Type.Simple' 'Control.Lens.Iso.Iso' a c       -> (c -> e) -> m e+-- 'uses' :: ('MonadState' a m, 'Monoid' r) => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a c -> (c -> r) -> m r -- @ uses :: MonadState a m => Getting e a c -> (c -> e) -> m e uses l f = State.gets (views l f)@@ -251,11 +254,11 @@ -- to a monoidal value. -- -- @--- query :: 'MonadReader' a m             => 'Getter' a c           -> m c--- query :: ('MonadReader' a m, 'Monoid' c) => 'Control.Lens.Fold.Fold' a c             -> m c--- query :: 'MonadReader' a m             => 'Control.Lens.Type.Simple' 'Control.Lens.Iso.Iso' a c       -> m c--- query :: 'MonadReader' a m             => 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a c      -> m c--- query :: ('MonadReader' a m, 'Monoid' c) => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a c -> m c+-- 'query' :: 'MonadReader' a m             => 'Getter' a c           -> m c+-- 'query' :: ('MonadReader' a m, 'Monoid' c) => 'Control.Lens.Fold.Fold' a c             -> m c+-- 'query' :: 'MonadReader' a m             => 'Control.Lens.Type.Simple' 'Control.Lens.Iso.Iso' a c       -> m c+-- 'query' :: 'MonadReader' a m             => 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a c      -> m c+-- 'query' :: ('MonadReader' a m, 'Monoid' c) => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a c -> m c -- @ query :: MonadReader a m => Getting c a c -> m c query l = Reader.asks (^.l)@@ -268,14 +271,15 @@ -- to a monoidal value. -- -- @--- queries :: 'MonadReader' a m             => 'Getter' a c           -> (c -> e) -> m e--- queries :: ('MonadReader' a m, 'Monoid' c) => 'Control.Lens.Fold.Fold' a c             -> (c -> e) -> m e--- queries :: 'MonadReader' a m             => 'Control.Lens.Type.Simple' 'Control.Lens.Iso.Iso' a c       -> (c -> e) -> m e--- queries :: 'MonadReader' a m             => 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a c      -> (c -> e) -> m e--- queries :: ('MonadReader' a m, 'Monoid' c) => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a c -> (c -> e) -> m e+-- 'queries' :: 'MonadReader' a m             => 'Getter' a c           -> (c -> e) -> m e+-- 'queries' :: ('MonadReader' a m, 'Monoid' c) => 'Control.Lens.Fold.Fold' a c             -> (c -> e) -> m e+-- 'queries' :: 'MonadReader' a m             => 'Control.Lens.Type.Simple' 'Control.Lens.Iso.Iso' a c       -> (c -> e) -> m e+-- 'queries' :: 'MonadReader' a m             => 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a c      -> (c -> e) -> m e+-- 'queries' :: ('MonadReader' a m, 'Monoid' c) => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a c -> (c -> e) -> m e -- @ queries :: MonadReader a m => Getting e a c -> (c -> e) -> m e queries l f = Reader.asks (views l f) {-# INLINE queries #-} -+-- | Useful for storing getters in containers.+newtype ReifiedGetter a c = ReifyGetter { reflectGetter :: Getter a c }
src/Control/Lens/Indexed.hs view
@@ -23,8 +23,11 @@   , (<.>), (<.), (.>)   , icompose   , reindex+  , indexed   ) where +import Control.Lens.Internal+ infixr 9 <.>, <., .>  -- | Permit overloading of function application for things that also admit a notion of a key or index.@@ -91,3 +94,19 @@ {-# INLINE icompose #-} {-# SPECIALIZE icompose :: (i -> j -> k) -> Index i b c -> Index j a b -> a -> c #-} {-# SPECIALIZE icompose :: (k ~ l) => (i -> j -> k) -> Index i b c -> Index j a b -> Index l a c #-}++-- | Transform an Traversal into an IndexedTraversal, a Fold into an IndexedFold, etc.+--+-- @+-- 'indexed' :: 'Traversal' a b c d -> 'IndexedTraversal' 'Int' a b c d+-- 'indexed' :: 'Lens' a b c d      -> 'IndexedLens' 'Int' a b c d+-- 'indexed' :: 'Fold' a b          -> 'IndexedFold' 'Int' a b+-- 'indexed' :: 'Iso' a b c d       -> 'IndexedLens' 'Int' a b c d+-- 'indexed' :: 'Getter' a b        -> 'IndexedGetter' 'Int' a b c d+-- @+indexed :: Indexed Int k => ((c -> Indexing f d) -> a -> Indexing f b) -> k (c -> f d) (a -> f b)+indexed l = index $ \icfd a -> case runIndexing (l (\c -> Indexing (\i -> IndexingResult (icfd i c) (i + 1))) a) 0 of+  IndexingResult r _ -> r+{-# INLINE indexed #-}+{-# SPECIALIZE indexed :: ((c -> Indexing f d) -> a -> Indexing f b) -> (c -> f d) -> (a -> f b) #-}+{-# SPECIALIZE indexed :: ((c -> Indexing f d) -> a -> Indexing f b) -> Index Int (c -> f d) (a -> f b) #-}
src/Control/Lens/IndexedFold.hs view
@@ -40,6 +40,9 @@   , ifiltered   , itakingWhile   , idroppingWhile++  -- * Storing Indexed Folds+  , ReifiedIndexedFold(..)   ) where  import Control.Applicative@@ -65,10 +68,10 @@ -- @'Control.Lens.Fold.foldMapOf' l = 'ifoldMapOf' l . 'const'@ -- -- @--- ifoldMapOf ::             'IndexedGetter' i a c          -> (i -> c -> m) -> a -> m--- ifoldMapOf :: 'Monoid' m => 'IndexedFold' i a c            -> (i -> c -> m) -> a -> m--- ifoldMapOf ::             'Control.Lens.IndexedLens.SimpleIndexedLens' i a c      -> (i -> c -> m) -> a -> m--- ifoldMapOf :: 'Monoid' m => 'Control.Lens.IndexedTraversal.SimpleIndexedTraversal' i a c -> (i -> c -> m) -> a -> m+-- 'ifoldMapOf' ::             'IndexedGetter' i a c          -> (i -> c -> m) -> a -> m+-- 'ifoldMapOf' :: 'Monoid' m => 'IndexedFold' i a c            -> (i -> c -> m) -> a -> m+-- 'ifoldMapOf' ::             'Control.Lens.IndexedLens.SimpleIndexedLens' i a c      -> (i -> c -> m) -> a -> m+-- 'ifoldMapOf' :: 'Monoid' m => 'Control.Lens.IndexedTraversal.SimpleIndexedTraversal' i a c -> (i -> c -> m) -> a -> m -- @ ifoldMapOf :: IndexedGetting i m a c -> (i -> c -> m) -> a -> m ifoldMapOf l f = runAccessor . withIndex l (\i -> Accessor . f i)@@ -83,10 +86,10 @@ -- @'Control.Lens.Fold.foldrOf' l = 'ifoldrOf' l . 'const'@ -- -- @--- ifoldrOf :: 'IndexedGetter' i a c          -> (i -> c -> e -> e) -> e -> a -> e--- ifoldrOf :: 'IndexedFold' i a c            -> (i -> c -> e -> e) -> e -> a -> e--- ifoldrOf :: 'Control.Lens.IndexedLens.SimpleIndexedLens' i a c      -> (i -> c -> e -> e) -> e -> a -> e--- ifoldrOf :: 'Control.Lens.IndexedTraversal.SimpleIndexedTraversal' i a c -> (i -> c -> e -> e) -> e -> a -> e+-- 'ifoldrOf' :: 'IndexedGetter' i a c          -> (i -> c -> e -> e) -> e -> a -> e+-- 'ifoldrOf' :: 'IndexedFold' i a c            -> (i -> c -> e -> e) -> e -> a -> e+-- 'ifoldrOf' :: 'Control.Lens.IndexedLens.SimpleIndexedLens' i a c      -> (i -> c -> e -> e) -> e -> a -> e+-- 'ifoldrOf' :: 'Control.Lens.IndexedTraversal.SimpleIndexedTraversal' i a c -> (i -> c -> e -> e) -> e -> a -> e -- @ ifoldrOf :: IndexedGetting i (Endo e) a c -> (i -> c -> e -> e) -> e -> a -> e ifoldrOf l f z t = appEndo (ifoldMapOf l (\i -> Endo . f i) t) z@@ -101,10 +104,10 @@ -- @'Control.Lens.Fold.foldlOf' l = 'ifoldlOf' l . 'const'@ -- -- @--- ifoldlOf :: 'IndexedGetter' i a c          -> (i -> e -> c -> e) -> e -> a -> e--- ifoldlOf :: 'IndexedFold' i a c            -> (i -> e -> c -> e) -> e -> a -> e--- ifoldlOf :: 'Control.Lens.IndexedLens.SimpleIndexedLens' i a c      -> (i -> e -> c -> e) -> e -> a -> e--- ifoldlOf :: 'Control.Lens.IndexedTraversal.SimpleIndexedTraversal' i a c -> (i -> e -> c -> e) -> e -> a -> e+-- 'ifoldlOf' :: 'IndexedGetter' i a c          -> (i -> e -> c -> e) -> e -> a -> e+-- 'ifoldlOf' :: 'IndexedFold' i a c            -> (i -> e -> c -> e) -> e -> a -> e+-- 'ifoldlOf' :: 'Control.Lens.IndexedLens.SimpleIndexedLens' i a c      -> (i -> e -> c -> e) -> e -> a -> e+-- 'ifoldlOf' :: 'Control.Lens.IndexedTraversal.SimpleIndexedTraversal' i a c -> (i -> e -> c -> e) -> e -> a -> e -- @ ifoldlOf :: IndexedGetting i (Dual (Endo e)) a c -> (i -> e -> c -> e) -> e -> a -> e ifoldlOf l f z t = appEndo (getDual (ifoldMapOf l (\i -> Dual . Endo . flip (f i)) t)) z@@ -119,10 +122,10 @@ -- @'Control.Lens.Fold.anyOf' l = 'ianyOf' l . 'const'@ -- -- @--- ianyOf :: 'IndexedGetter' i a c          -> (i -> c -> 'Bool') -> a -> 'Bool'--- ianyOf :: 'IndexedFold' i a c            -> (i -> c -> 'Bool') -> a -> 'Bool'--- ianyOf :: 'Control.Lens.IndexedLens.SimpleIndexedLens' i a c      -> (i -> c -> 'Bool') -> a -> 'Bool'--- ianyOf :: 'Control.Lens.IndexedTraversal.SimpleIndexedTraversal' i a c -> (i -> c -> 'Bool') -> a -> 'Bool'+-- 'ianyOf' :: 'IndexedGetter' i a c          -> (i -> c -> 'Bool') -> a -> 'Bool'+-- 'ianyOf' :: 'IndexedFold' i a c            -> (i -> c -> 'Bool') -> a -> 'Bool'+-- 'ianyOf' :: 'Control.Lens.IndexedLens.SimpleIndexedLens' i a c      -> (i -> c -> 'Bool') -> a -> 'Bool'+-- 'ianyOf' :: 'Control.Lens.IndexedTraversal.SimpleIndexedTraversal' i a c -> (i -> c -> 'Bool') -> a -> 'Bool' -- @ ianyOf :: IndexedGetting i Any a c -> (i -> c -> Bool) -> a -> Bool ianyOf l f = getAny . ifoldMapOf l (\i -> Any . f i)@@ -137,10 +140,10 @@ -- @'Control.Lens.Fold.allOf' l = 'iallOf' l . 'const'@ -- -- @--- iallOf :: 'IndexedGetter' i a c          -> (i -> c -> 'Bool') -> a -> 'Bool'--- iallOf :: 'IndexedFold' i a c            -> (i -> c -> 'Bool') -> a -> 'Bool'--- iallOf :: 'Control.Lens.IndexedLens.SimpleIndexedLens' i a c      -> (i -> c -> 'Bool') -> a -> 'Bool'--- iallOf :: 'Control.Lens.IndexedTraversal.SimpleIndexedTraversal' i a c -> (i -> c -> 'Bool') -> a -> 'Bool'+-- 'iallOf' :: 'IndexedGetter' i a c          -> (i -> c -> 'Bool') -> a -> 'Bool'+-- 'iallOf' :: 'IndexedFold' i a c            -> (i -> c -> 'Bool') -> a -> 'Bool'+-- 'iallOf' :: 'Control.Lens.IndexedLens.SimpleIndexedLens' i a c      -> (i -> c -> 'Bool') -> a -> 'Bool'+-- 'iallOf' :: 'Control.Lens.IndexedTraversal.SimpleIndexedTraversal' i a c -> (i -> c -> 'Bool') -> a -> 'Bool' -- @ iallOf :: IndexedGetting i All a c -> (i -> c -> Bool) -> a -> Bool iallOf l f = getAll . ifoldMapOf l (\i -> All . f i)@@ -154,10 +157,10 @@ -- @'Control.Lens.Fold.traverseOf_' l = 'itraverseOf' l . 'const'@ -- -- @--- itraverseOf_ :: 'Functor' f     => 'IndexedGetter' i a c          -> (i -> c -> f e) -> a -> f ()--- itraverseOf_ :: 'Applicative' f => 'IndexedFold' i a c            -> (i -> c -> f e) -> a -> f ()--- itraverseOf_ :: 'Functor' f     => 'Control.Lens.IndexedLens.SimpleIndexedLens' i a c      -> (i -> c -> f e) -> a -> f ()--- itraverseOf_ :: 'Applicative' f => 'Control.Lens.IndexedTraversal.SimpleIndexedTraversal' i a c -> (i -> c -> f e) -> a -> f ()+-- 'itraverseOf_' :: 'Functor' f     => 'IndexedGetter' i a c          -> (i -> c -> f e) -> a -> f ()+-- 'itraverseOf_' :: 'Applicative' f => 'IndexedFold' i a c            -> (i -> c -> f e) -> a -> f ()+-- 'itraverseOf_' :: 'Functor' f     => 'Control.Lens.IndexedLens.SimpleIndexedLens' i a c      -> (i -> c -> f e) -> a -> f ()+-- 'itraverseOf_' :: 'Applicative' f => 'Control.Lens.IndexedTraversal.SimpleIndexedTraversal' i a c -> (i -> c -> f e) -> a -> f () -- @ itraverseOf_ :: Functor f => IndexedGetting i (Traversed f) a c -> (i -> c -> f e) -> a -> f () itraverseOf_ l f = getTraversed . ifoldMapOf l (\i -> Traversed . void . f i)@@ -171,13 +174,13 @@ -- -- When you don't need access to the index then 'Control.Lens.Fold.forOf_' is more flexible in what it accepts. ----- @'Control.Lens.Fold.forOf_' l a = 'iforOf' l a . 'const'@+-- @'Control.Lens.Fold.forOf_' l a = 'iforOf_' l a . 'const'@ -- -- @--- iforOf_ :: 'Functor' f     => 'IndexedGetter' i a c          -> a -> (i -> c -> f e) -> f ()--- iforOf_ :: 'Applicative' f => 'IndexedFold' i a c            -> a -> (i -> c -> f e) -> f ()--- iforOf_ :: 'Functor' f     => 'Control.Lens.IndexedLens.SimpleIndexedLens' i a c      -> a -> (i -> c -> f e) -> f ()--- iforOf_ :: 'Applicative' f => 'Control.Lens.IndexedTraversal.SimpleIndexedTraversal' i a c -> a -> (i -> c -> f e) -> f ()+-- 'iforOf_' :: 'Functor' f     => 'IndexedGetter' i a c          -> a -> (i -> c -> f e) -> f ()+-- 'iforOf_' :: 'Applicative' f => 'IndexedFold' i a c            -> a -> (i -> c -> f e) -> f ()+-- 'iforOf_' :: 'Functor' f     => 'Control.Lens.IndexedLens.SimpleIndexedLens' i a c      -> a -> (i -> c -> f e) -> f ()+-- 'iforOf_' :: 'Applicative' f => 'Control.Lens.IndexedTraversal.SimpleIndexedTraversal' i a c -> a -> (i -> c -> f e) -> f () -- @ iforOf_ :: Functor f => IndexedGetting i (Traversed f) a c -> a -> (i -> c -> f e) -> f () iforOf_ = flip . itraverseOf_@@ -192,10 +195,10 @@ -- @'Control.Lens.Fold.mapMOf_' l = 'imapMOf' l . 'const'@ -- -- @--- imapMOf_ :: 'Monad' m => 'IndexedGetter' i a c          -> (i -> c -> m e) -> a -> m ()--- imapMOf_ :: 'Monad' m => 'IndexedFold' i a c            -> (i -> c -> m e) -> a -> m ()--- imapMOf_ :: 'Monad' m => 'Control.Lens.IndexedLens.SimpleIndexedLens' i a c      -> (i -> c -> m e) -> a -> m ()--- imapMOf_ :: 'Monad' m => 'Control.Lens.IndexedTraversal.SimpleIndexedTraversal' i a c -> (i -> c -> m e) -> a -> m ()+-- 'imapMOf_' :: 'Monad' m => 'IndexedGetter' i a c          -> (i -> c -> m e) -> a -> m ()+-- 'imapMOf_' :: 'Monad' m => 'IndexedFold' i a c            -> (i -> c -> m e) -> a -> m ()+-- 'imapMOf_' :: 'Monad' m => 'Control.Lens.IndexedLens.SimpleIndexedLens' i a c      -> (i -> c -> m e) -> a -> m ()+-- 'imapMOf_' :: 'Monad' m => 'Control.Lens.IndexedTraversal.SimpleIndexedTraversal' i a c -> (i -> c -> m e) -> a -> m () -- @ imapMOf_ :: Monad m => IndexedGetting i (Sequenced m) a c -> (i -> c -> m e) -> a -> m () imapMOf_ l f = getSequenced . ifoldMapOf l (\i -> Sequenced . liftM skip . f i)@@ -216,10 +219,10 @@ -- @'Control.Lens.Fold.forMOf_' l a = 'iforMOf' l a . 'const'@ -- -- @--- iforMOf_ :: 'Monad' m => 'IndexedGetter' i a c          -> a -> (i -> c -> m e) -> m ()--- iforMOf_ :: 'Monad' m => 'IndexedFold' i a c            -> a -> (i -> c -> m e) -> m ()--- iforMOf_ :: 'Monad' m => 'Control.Lens.IndexedLens.SimpleIndexedLens' i a c      -> a -> (i -> c -> m e) -> m ()--- iforMOf_ :: 'Monad' m => 'Control.Lens.IndexedTraversal.SimpleIndexedTraversal' i a c -> a -> (i -> c -> m e) -> m ()+-- 'iforMOf_' :: 'Monad' m => 'IndexedGetter' i a c          -> a -> (i -> c -> m e) -> m ()+-- 'iforMOf_' :: 'Monad' m => 'IndexedFold' i a c            -> a -> (i -> c -> m e) -> m ()+-- 'iforMOf_' :: 'Monad' m => 'Control.Lens.IndexedLens.SimpleIndexedLens' i a c      -> a -> (i -> c -> m e) -> m ()+-- 'iforMOf_' :: 'Monad' m => 'Control.Lens.IndexedTraversal.SimpleIndexedTraversal' i a c -> a -> (i -> c -> m e) -> m () -- @ iforMOf_ :: Monad m => IndexedGetting i (Sequenced m) a c -> a -> (i -> c -> m e) -> m () iforMOf_ = flip . imapMOf_@@ -229,18 +232,21 @@ -- Concatenate the results of a function of the elements of an 'IndexedFold' or 'Control.Lens.IndexedTraversal.IndexedTraversal' -- with access to the index. ----- When you don't need access to the index then 'Control.Lens.Fold.concatMapOf_'  is more flexible in what it accepts.+-- When you don't need access to the index then 'Control.Lens.Fold.concatMapOf'  is more flexible in what it accepts. ----- @'Control.Lens.Fold.concatMapOf_' l = 'iconcatMapMOf' l . 'const'@+-- @+-- 'Control.Lens.Fold.concatMapOf' l = 'iconcatMapOf' l . 'const'+-- 'iconcatMapOf' = 'ifoldMapOf'+-- @ -- -- @--- iconcatMapOf :: 'IndexedGetter' i a c          -> (i -> c -> [e]) -> a -> [e]--- iconcatMapOf :: 'IndexedFold' i a c            -> (i -> c -> [e]) -> a -> [e]--- iconcatMapOf :: 'Control.Lens.IndexedLens.SimpleIndexedLens' i a c      -> (i -> c -> [e]) -> a -> [e]--- iconcatMapOf :: 'Control.Lens.IndexedTraversal.SimpleIndexedTraversal' i a c -> (i -> c -> [e]) -> a -> [e]+-- 'iconcatMapOf' :: 'IndexedGetter' i a c          -> (i -> c -> [e]) -> a -> [e]+-- 'iconcatMapOf' :: 'IndexedFold' i a c            -> (i -> c -> [e]) -> a -> [e]+-- 'iconcatMapOf' :: 'Control.Lens.IndexedLens.SimpleIndexedLens' i a c      -> (i -> c -> [e]) -> a -> [e]+-- 'iconcatMapOf' :: 'Control.Lens.IndexedTraversal.SimpleIndexedTraversal' i a c -> (i -> c -> [e]) -> a -> [e] -- @ iconcatMapOf :: IndexedGetting i [e] a c -> (i -> c -> [e]) -> a -> [e]-iconcatMapOf l ices = runAccessor . withIndex l (\i -> Accessor . ices i)+iconcatMapOf = ifoldMapOf {-# INLINE iconcatMapOf #-}  -- | The 'findOf' function takes an 'IndexedFold' or 'Control.Lens.IndexedTraversal.IndexedTraversal', a predicate that is also@@ -249,13 +255,13 @@ -- -- When you don't need access to the index then 'Control.Lens.Fold.findOf' is more flexible in what it accepts. ----- @'Control.Lens.Fold.findOf' l = 'ifoldOf' l . 'const'@+-- @'Control.Lens.Fold.findOf' l = 'ifindOf' l . 'const'@ -- -- @--- ifindOf :: 'IndexedGetter' a c          -> (i -> c -> 'Bool') -> a -> 'Maybe' (i, c)--- ifindOf :: 'IndexedFold' a c            -> (i -> c -> 'Bool') -> a -> 'Maybe' (i, c)--- ifindOf :: 'Control.Lens.IndexedLens.SimpleIndexedLens' a c      -> (i -> c -> 'Bool') -> a -> 'Maybe' (i, c)--- ifindOf :: 'Control.Lens.IndexedTraversal.SimpleIndexedTraversal' a c -> (i -> c -> 'Bool') -> a -> 'Maybe' (i, c)+-- 'ifindOf' :: 'IndexedGetter' a c          -> (i -> c -> 'Bool') -> a -> 'Maybe' (i, c)+-- 'ifindOf' :: 'IndexedFold' a c            -> (i -> c -> 'Bool') -> a -> 'Maybe' (i, c)+-- 'ifindOf' :: 'Control.Lens.IndexedLens.SimpleIndexedLens' a c      -> (i -> c -> 'Bool') -> a -> 'Maybe' (i, c)+-- 'ifindOf' :: 'Control.Lens.IndexedTraversal.SimpleIndexedTraversal' a c -> (i -> c -> 'Bool') -> a -> 'Maybe' (i, c) -- @ ifindOf :: IndexedGetting i (First (i, c)) a c -> (i -> c -> Bool) -> a -> Maybe (i, c) ifindOf l p = getFirst . ifoldMapOf l step where@@ -271,10 +277,10 @@ -- @'Control.Lens.Fold.foldrOf'' l = 'ifoldrOf'' l . 'const'@ -- -- @--- ifoldrOf' :: 'IndexedGetter' i a c          -> (i -> c -> e -> e) -> e -> a -> e--- ifoldrOf' :: 'IndexedFold' i a c            -> (i -> c -> e -> e) -> e -> a -> e--- ifoldrOf' :: 'Control.Lens.IndexedLens.SimpleIndexedLens' i a c      -> (i -> c -> e -> e) -> e -> a -> e--- ifoldrOf' :: 'Control.Lens.IndexedTraversal.SimpleIndexedTraversal' i a c -> (i -> c -> e -> e) -> e -> a -> e+-- 'ifoldrOf'' :: 'IndexedGetter' i a c          -> (i -> c -> e -> e) -> e -> a -> e+-- 'ifoldrOf'' :: 'IndexedFold' i a c            -> (i -> c -> e -> e) -> e -> a -> e+-- 'ifoldrOf'' :: 'Control.Lens.IndexedLens.SimpleIndexedLens' i a c      -> (i -> c -> e -> e) -> e -> a -> e+-- 'ifoldrOf'' :: 'Control.Lens.IndexedTraversal.SimpleIndexedTraversal' i a c -> (i -> c -> e -> e) -> e -> a -> e -- @ ifoldrOf' :: IndexedGetting i (Dual (Endo (e -> e))) a c -> (i -> c -> e -> e) -> e -> a -> e ifoldrOf' l f z0 xs = ifoldlOf l f' id xs z0@@ -288,10 +294,10 @@ -- @'Control.Lens.Fold.foldlOf'' l = 'ifoldlOf'' l . 'const'@ -- -- @--- ifoldlOf' :: 'IndexedGetter' i a c            -> (i -> e -> c -> e) -> e -> a -> e--- ifoldlOf' :: 'IndexedFold' i a c              -> (i -> e -> c -> e) -> e -> a -> e--- ifoldlOf' :: 'Control.Lens.IndexedLens.SimpleIndexedLens' i a c        -> (i -> e -> c -> e) -> e -> a -> e--- ifoldlOf' :: 'Control.Lens.IndexedTraversal.SimpleIndexedTraversal' i a c   -> (i -> e -> c -> e) -> e -> a -> e+-- 'ifoldlOf'' :: 'IndexedGetter' i a c            -> (i -> e -> c -> e) -> e -> a -> e+-- 'ifoldlOf'' :: 'IndexedFold' i a c              -> (i -> e -> c -> e) -> e -> a -> e+-- 'ifoldlOf'' :: 'Control.Lens.IndexedLens.SimpleIndexedLens' i a c        -> (i -> e -> c -> e) -> e -> a -> e+-- 'ifoldlOf'' :: 'Control.Lens.IndexedTraversal.SimpleIndexedTraversal' i a c   -> (i -> e -> c -> e) -> e -> a -> e -- @ ifoldlOf' :: IndexedGetting i (Endo (e -> e)) a c -> (i -> e -> c -> e) -> e -> a -> e ifoldlOf' l f z0 xs = ifoldrOf l f' id xs z0@@ -305,10 +311,10 @@ -- @'Control.Lens.Fold.foldrMOf' l = 'ifoldrMOf' l . 'const'@ -- -- @--- ifoldrMOf :: 'Monad' m => 'IndexedGetter' i a c          -> (i -> c -> e -> m e) -> e -> a -> e--- ifoldrMOf :: 'Monad' m => 'IndexedFold' i a c            -> (i -> c -> e -> m e) -> e -> a -> e--- ifoldrMOf :: 'Monad' m => 'Control.Lens.IndexedLens.SimpleIndexedLens' i a c      -> (i -> c -> e -> m e) -> e -> a -> e--- ifoldrMOf :: 'Monad' m => 'Control.Lens.IndexedTraversal.SimpleIndexedTraversal' i a c -> (i -> c -> e -> m e) -> e -> a -> e+-- 'ifoldrMOf' :: 'Monad' m => 'IndexedGetter' i a c          -> (i -> c -> e -> m e) -> e -> a -> e+-- 'ifoldrMOf' :: 'Monad' m => 'IndexedFold' i a c            -> (i -> c -> e -> m e) -> e -> a -> e+-- 'ifoldrMOf' :: 'Monad' m => 'Control.Lens.IndexedLens.SimpleIndexedLens' i a c      -> (i -> c -> e -> m e) -> e -> a -> e+-- 'ifoldrMOf' :: 'Monad' m => 'Control.Lens.IndexedTraversal.SimpleIndexedTraversal' i a c -> (i -> c -> e -> m e) -> e -> a -> e -- @ ifoldrMOf :: Monad m => IndexedGetting i (Dual (Endo (e -> m e))) a c -> (i -> c -> e -> m e) -> e -> a -> m e ifoldrMOf l f z0 xs = ifoldlOf l f' return xs z0@@ -322,10 +328,10 @@ -- @'Control.Lens.Fold.foldlMOf' l = 'ifoldlMOf' l . 'const'@ -- -- @--- ifoldlOf' :: 'Monad' m => 'IndexedGetter' i a c            -> (i -> e -> c -> m e) -> e -> a -> e--- ifoldlOf' :: 'Monad' m => 'IndexedFold' i a c              -> (i -> e -> c -> m e) -> e -> a -> e--- ifoldlOf' :: 'Monad' m => 'Control.Lens.IndexedLens.SimpleIndexedLens' i a c        -> (i -> e -> c -> m e) -> e -> a -> e--- ifoldlOf' :: 'Monad' m => 'Control.Lens.IndexedTraversal.SimpleIndexedTraversal' i a c   -> (i -> e -> c -> m e) -> e -> a -> e+-- 'ifoldlOf'' :: 'Monad' m => 'IndexedGetter' i a c            -> (i -> e -> c -> m e) -> e -> a -> e+-- 'ifoldlOf'' :: 'Monad' m => 'IndexedFold' i a c              -> (i -> e -> c -> m e) -> e -> a -> e+-- 'ifoldlOf'' :: 'Monad' m => 'Control.Lens.IndexedLens.SimpleIndexedLens' i a c        -> (i -> e -> c -> m e) -> e -> a -> e+-- 'ifoldlOf'' :: 'Monad' m => 'Control.Lens.IndexedTraversal.SimpleIndexedTraversal' i a c   -> (i -> e -> c -> m e) -> e -> a -> e -- @ ifoldlMOf :: Monad m => IndexedGetting i (Endo (e -> m e)) a c -> (i -> e -> c -> m e) -> e -> a -> m e ifoldlMOf l f z0 xs = ifoldrOf l f' return xs z0@@ -339,10 +345,10 @@ -- @'Control.Lens.Fold.toListOf' l = 'map' 'fst' . 'itoListOf' l@ -- -- @--- itoListOf :: 'IndexedGetter' i a c          -> a -> [(i,c)]--- itoListOf :: 'IndexedFold' i a c            -> a -> [(i,c)]--- itoListOf :: 'Control.Lens.IndexedLens.SimpleIndexedLens' i a c      -> a -> [(i,c)]--- itoListOf :: 'Control.Lens.IndexedTraversal.SimpleIndexedTraversal' i a c -> a -> [(i,c)]+-- 'itoListOf' :: 'IndexedGetter' i a c          -> a -> [(i,c)]+-- 'itoListOf' :: 'IndexedFold' i a c            -> a -> [(i,c)]+-- 'itoListOf' :: 'Control.Lens.IndexedLens.SimpleIndexedLens' i a c      -> a -> [(i,c)]+-- 'itoListOf' :: 'Control.Lens.IndexedTraversal.SimpleIndexedTraversal' i a c -> a -> [(i,c)] -- @ itoListOf :: IndexedGetting i [(i,c)] a c -> a -> [(i,c)] itoListOf l = ifoldMapOf l (\i c -> [(i,c)])@@ -373,3 +379,10 @@               -> k (c -> f c) (a -> f a) idroppingWhile p l = index $ \f -> ifoldrOf l (\i a r -> if p i a then r else f i a *> r) noEffect {-# INLINE idroppingWhile #-}++------------------------------------------------------------------------------+-- Reifying Indexed Folds+------------------------------------------------------------------------------++-- | Useful for storage.+newtype ReifiedIndexedFold i a c = ReifyIndexedFold { reflectIndexedFold :: IndexedFold i a c }
src/Control/Lens/IndexedGetter.hs view
@@ -15,6 +15,7 @@   -- * Indexed Folds     IndexedGetter   , IndexedGetting+  , ReifiedIndexedGetter(..)   ) where  import Control.Lens.Indexed@@ -29,3 +30,6 @@  -- | Used to consume an 'Control.Lens.IndexedFold.IndexedFold'. type IndexedGetting i m a c = Index i (c -> Accessor m c) (a -> Accessor m a)++-- | Useful for storage.+newtype ReifiedIndexedGetter i a c = ReifyIndexedGetter { reflectIndexedGetter :: IndexedGetter i a c }
src/Control/Lens/IndexedLens.hs view
@@ -1,9 +1,10 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}  #ifndef MIN_VERSION_mtl #define MIN_VERSION_mtl(x,y,z) 1@@ -23,19 +24,34 @@   (   -- * Indexed Lenses     IndexedLens+  -- * Common Indexed Lenses+  , At(..)+  , Contains(..)+  -- * Indexed Lens Combinators   , (%%@~)   , (<%@~)   , (%%@=)   , (<%@=)-+  -- * Storing Indexed Lenses+  , ReifiedIndexedLens(..)   -- * Simple   , SimpleIndexedLens+  , SimpleReifiedIndexedLens   ) where +import Control.Applicative import Control.Lens.Indexed import Control.Lens.Type import Control.Monad.State.Class as State+import Data.Hashable+import Data.HashMap.Lazy as HashMap+import Data.IntMap as IntMap+import Data.Map as Map +import Data.HashSet as HashSet+import Data.IntSet as IntSet+import Data.Set as Set+ infixr 4 %%@~, <%@~ infix  4 %%@=, <%@= @@ -56,8 +72,8 @@ -- If you do not need the intermediate result, you can use ('Control.Lens.Type.%@~') or even ('Control.Lens.Type.%~'). -- -- @--- (\<%\@~) ::             'IndexedLens' i a b c d -> (i -> c -> d) -> a -> (d, b)--- (\<%\@~) :: 'Monoid' d => 'Control.Lens.IndexedTraversal.IndexedTraversal' i a b c d -> (i -> c -> d) -> a -> (d, b)+-- ('\<%\@~') ::             'IndexedLens' i a b c d -> (i -> c -> d) -> a -> (d, b)+-- ('\<%\@~') :: 'Monoid' d => 'Control.Lens.IndexedTraversal.IndexedTraversal' i a b c d -> (i -> c -> d) -> a -> (d, b) -- @ (<%@~) :: Overloaded (Index i) ((,)d) a b c d -> (i -> c -> d) -> a -> (d, b) l <%@~ f = withIndex l $ \i c -> let d = f i c in (d, d)@@ -70,16 +86,16 @@ -- @('%%@~') = 'withIndex'@ -- -- @--- (%%\@~) :: 'Functor' f => 'IndexedLens' i a b c d      -> (i -> c -> f d) -> a -> f b--- (%%\@~) :: 'Functor' f => 'Control.Lens.IndexedTraversal.IndexedTraversal' i a b c d -> (i -> c -> f d) -> a -> f b+-- ('%%\@~') :: 'Functor' f => 'IndexedLens' i a b c d      -> (i -> c -> f d) -> a -> f b+-- ('%%\@~') :: 'Functor' f => 'Control.Lens.IndexedTraversal.IndexedTraversal' i a b c d -> (i -> c -> f d) -> a -> f b -- @ ----- In particular, it is often useful to think of this function as having one of these even more +-- In particular, it is often useful to think of this function as having one of these even more -- restrictive type signatures -- -- @--- (%%\@~) ::             'IndexedLens' i a b c d      -> (i -> c -> (e, d)) -> a -> (e, b)--- (%%\@~) :: 'Monoid' e => 'Control.Lens.IndexedTraversal.IndexedTraversal' i a b c d -> (i -> c -> (e, d)) -> a -> (e, b)+-- ('%%\@~') ::             'IndexedLens' i a b c d      -> (i -> c -> (e, d)) -> a -> (e, b)+-- ('%%\@~') :: 'Monoid' e => 'Control.Lens.IndexedTraversal.IndexedTraversal' i a b c d -> (i -> c -> (e, d)) -> a -> (e, b) -- @ (%%@~) :: Overloaded (Index i) f a b c d -> (i -> c -> f d) -> a -> f b (%%@~) = withIndex@@ -92,8 +108,8 @@ -- @l '%%@=' f = 'state' (l '%%@~' f)@ -- -- @--- (%%\@=) :: 'MonadState' a m                'IndexedLens' i a a c d      -> (i -> c -> (e, d)) -> a -> m e--- (%%\@=) :: ('MonadState' a m, 'Monoid' e) => 'Control.Lens.IndexedTraversal.IndexedTraversal' i a a c d -> (i -> c -> (e, d)) -> a -> m e+-- ('%%\@=') :: 'MonadState' a m                'IndexedLens' i a a c d      -> (i -> c -> (e, d)) -> a -> m e+-- ('%%\@=') :: ('MonadState' a m, 'Monoid' e) => 'Control.Lens.IndexedTraversal.IndexedTraversal' i a a c d -> (i -> c -> (e, d)) -> a -> m e -- @ (%%@=) :: MonadState a m => Overloaded (Index i) ((,)e) a a c d -> (i -> c -> (e, d)) -> m e #if MIN_VERSION_mtl(2,1,0)@@ -111,9 +127,68 @@ -- return a monoidal summary of the intermediate results. -- -- @--- (\<%\@=) :: 'MonadState' a m                'IndexedLens' i a a c d      -> (i -> c -> d) -> a -> m d--- (\<%\@=) :: ('MonadState' a m, 'Monoid' e) => 'Control.Lens.IndexedTraversal.IndexedTraversal' i a a c d -> (i -> c -> d) -> a -> m d+-- ('\<%\@=') :: 'MonadState' a m                'IndexedLens' i a a c d      -> (i -> c -> d) -> a -> m d+-- ('\<%\@=') :: ('MonadState' a m, 'Monoid' e) => 'Control.Lens.IndexedTraversal.IndexedTraversal' i a a c d -> (i -> c -> d) -> a -> m d -- @ (<%@=) :: MonadState a m => Overloaded (Index i) ((,)d) a a c d -> (i -> c -> d) -> m d l <%@= f = l %%@= \ i c -> let d = f i c in (d, d) {-# INLINE (<%@=) #-}++-- | Provides an 'IndexedLens' that can be used to read, write or delete the value associated with a key in a map-like container.+class At k m | m -> k where+  -- |+  -- >>> import Control.Lens+  -- >>> Map.fromList [(1,"hello")] ^.at 1+  -- Just "hello"+  --+  -- >>> at 1 .~ Just "hello" $ Map.empty+  -- fromList [(1,"hello")]+  at :: k -> SimpleIndexedLens k (m v) (Maybe v)++instance At Int IntMap where+  at k = index $ \ f m -> (`go` m) <$> f k (IntMap.lookup k m) where+    go Nothing   = IntMap.delete k+    go (Just v') = IntMap.insert k v'+  {-# INLINE at #-}++instance Ord k => At k (Map k) where+  at k = index $ \ f m -> (`go` m) <$> f k (Map.lookup k m) where+    go Nothing   = Map.delete k+    go (Just v') = Map.insert k v'+  {-# INLINE at #-}++instance (Eq k, Hashable k) => At k (HashMap k) where+  at k = index $ \ f m -> (`go` m) <$> f k (HashMap.lookup k m) where+    go Nothing   = HashMap.delete k+    go (Just v') = HashMap.insert k v'+  {-# INLINE at #-}++-- | Provides an 'IndexedLens' that can be used to read, write or delete a member of a set-like container+class Contains k m | m -> k where+  -- |+  -- >>> :m + Control.Lens+  -- >>> contains 3 .~ False $ IntSet.fromList [1,2,3,4]+  -- fromList [1,2,4]+  contains :: k -> SimpleIndexedLens k m Bool++instance Contains Int IntSet where+  contains k = index $ \ f s -> (\b -> if b then IntSet.insert k s else IntSet.delete k s) <$> f k (IntSet.member k s) where+  {-# INLINE contains #-}++instance Ord k => Contains k (Set k) where+  contains k = index $ \ f s -> (\b -> if b then Set.insert k s else Set.delete k s) <$> f k (Set.member k s) where+  {-# INLINE contains #-}++instance (Eq k, Hashable k) => Contains k (HashSet k) where+  contains k = index $ \ f s -> (\b -> if b then HashSet.insert k s else HashSet.delete k s) <$> f k (HashSet.member k s) where+  {-# INLINE contains #-}++------------------------------------------------------------------------------+-- Reifying Indexed Lenses+------------------------------------------------------------------------------++-- | Useful for storage.+newtype ReifiedIndexedLens i a b c d = ReifyIndexedLens { reflectIndexedLens :: IndexedLens i a b c d }++-- | @type 'SimpleIndexedLens' i = 'Simple' ('ReifiedIndexedLens' i)@+type SimpleReifiedIndexedLens i a b = ReifiedIndexedLens i a a b b
src/Control/Lens/IndexedSetter.hs view
@@ -17,13 +17,18 @@   (   -- * Indexed Setter     IndexedSetter-  , imapOf+  , imapOf, iover+  , isets   , (%@~)   , (%@=)+  -- * Storing Indexed Setters+  , ReifiedIndexedSetter(..)   -- * Simple   , SimpleIndexedSetter+  , SimpleReifiedIndexedSetter   ) where +import Control.Applicative import Control.Lens.Indexed import Control.Lens.Internal import Control.Lens.Type@@ -34,7 +39,7 @@  -- | Every 'IndexedSetter' is a valid 'Setter' ----- The 'Setter' laws are still required to hold.+-- The 'Control.Lens.Setter.Setter' laws are still required to hold. type IndexedSetter i a b c d = forall f k. (Indexed i k, Settable f) => k (c -> f d) (a -> f b)  -- |@@ -45,17 +50,54 @@ -- -- When you do not need access to the index, then 'mapOf' is more liberal in what it can accept. ----- @'mapOf' l = 'imapOf' l . 'const'@+-- @'Control.Lens.Setter.mapOf' l = 'imapOf' l . 'const'@ -- -- @--- imapOf :: 'IndexedSetter' i a b c d    -> (i -> c -> d) -> a -> b--- imapOf :: 'Control.Lens.IndexedLens.IndexedLens' i a b c d      -> (i -> c -> d) -> a -> b--- imapOf :: 'Control.Lens.IndexedTraversal.IndexedTraversal' i a b c d -> (i -> c -> d) -> a -> b+-- 'imapOf' :: 'IndexedSetter' i a b c d    -> (i -> c -> d) -> a -> b+-- 'imapOf' :: 'Control.Lens.IndexedLens.IndexedLens' i a b c d      -> (i -> c -> d) -> a -> b+-- 'imapOf' :: 'Control.Lens.IndexedTraversal.IndexedTraversal' i a b c d -> (i -> c -> d) -> a -> b -- @ imapOf :: Overloaded (Index i) Mutator a b c d -> (i -> c -> d) -> a -> b imapOf l f = runMutator . withIndex l (\i -> Mutator . f i) {-# INLINE imapOf #-} +-- | Map with index. This is an alias for 'imapOf'.+--+-- When you do not need access to the index, then 'over' is more liberal in what it can accept.+--+-- @'Control.Lens.Setter.over' l = 'iover' l . 'const'@+--+-- @+-- 'iover' :: 'IndexedSetter' i a b c d    -> (i -> c -> d) -> a -> b+-- 'iover' :: 'Control.Lens.IndexedLens.IndexedLens' i a b c d      -> (i -> c -> d) -> a -> b+-- 'iover' :: 'Control.Lens.IndexedTraversal.IndexedTraversal' i a b c d -> (i -> c -> d) -> a -> b+-- @+iover :: Overloaded (Index i) Mutator a b c d -> (i -> c -> d) -> a -> b+iover l f = runMutator . withIndex l (\i -> Mutator . f i)+{-# INLINE iover #-}++-- | Build an 'IndexedSetter' from an 'imap'-like function.+--+-- Your supplied function @f@ is required to satisfy:+--+-- @+-- f 'id' = 'id'+-- f g '.' f h = f (g '.' h)+-- @+--+-- Equational reasoning:+--+-- @+-- 'isets' . 'iover' = 'id'+-- 'iover' . 'isets' = 'id'+-- @+--+-- Another way to view 'sets' is that it takes a \"semantic editor combinator\"+-- and transforms it into a 'Setter'.+isets :: ((i -> c -> d) -> a -> b) -> IndexedSetter i a b c d+isets f = index $ \ g -> pure . f (\i -> untainted . g i)+{-# INLINE isets #-}+ -- | Adjust every target of an 'IndexedSetter', 'Control.Lens.IndexedLens.IndexedLens' or 'Control.Lens.IndexedTraversal.IndexedTraversal' -- with access to the index. --@@ -63,12 +105,12 @@ -- -- When you do not need access to the index then ('%@~') is more liberal in what it can accept. ----- @l '%~' f = l '%@~' 'const' f@+-- @l 'Control.Lens.Setter.%~' f = l '%@~' 'const' f@ -- -- @--- (%\@~) :: 'IndexedSetter' i a b c d    -> (i -> c -> d) -> a -> b--- (%\@~) :: 'Control.Lens.IndexedLens.IndexedLens' i a b c d      -> (i -> c -> d) -> a -> b--- (%\@~) :: 'Control.Lens.IndexedTraversal.IndexedTraversal' i a b c d -> (i -> c -> d) -> a -> b+-- ('%@~') :: 'IndexedSetter' i a b c d    -> (i -> c -> d) -> a -> b+-- ('%@~') :: 'Control.Lens.IndexedLens.IndexedLens' i a b c d      -> (i -> c -> d) -> a -> b+-- ('%@~') :: 'Control.Lens.IndexedTraversal.IndexedTraversal' i a b c d -> (i -> c -> d) -> a -> b -- @ (%@~) :: Overloaded (Index i) Mutator a b c d -> (i -> c -> d) -> a -> b l %@~ f = runMutator . withIndex l (\i -> Mutator . f i)@@ -79,13 +121,24 @@ -- -- When you do not need access to the index then ('%=') is more liberal in what it can accept. ----- @l '%=' f = l '%@=' 'const' f@+-- @l 'Control.Lens.Setter.%=' f = l '%@=' 'const' f@ -- -- @--- (%\@=) :: 'MonadState' a m => 'IndexedSetter' i a a c d    -> (i -> c -> d) -> m ()--- (%\@=) :: 'MonadState' a m => 'Control.Lens.IndexedLens.IndexedLens' i a a c d      -> (i -> c -> d) -> m ()--- (%\@=) :: 'MonadState' a m => 'Control.Lens.IndexedTraversal.IndexedTraversal' i a b c d -> (i -> c -> d) -> m ()+-- ('%@=') :: 'MonadState' a m => 'IndexedSetter' i a a c d    -> (i -> c -> d) -> m ()+-- ('%@=') :: 'MonadState' a m => 'Control.Lens.IndexedLens.IndexedLens' i a a c d      -> (i -> c -> d) -> m ()+-- ('%@=') :: 'MonadState' a m => 'Control.Lens.IndexedTraversal.IndexedTraversal' i a b c d -> (i -> c -> d) -> m () -- @ (%@=) :: MonadState a m => Overloaded (Index i) Mutator a a c d -> (i -> c -> d) -> m () l %@= f = State.modify (l %@~ f) {-# INLINE (%@=) #-}++------------------------------------------------------------------------------+-- Reifying Indexed Setters+------------------------------------------------------------------------------++-- | Useful for storage.+newtype ReifiedIndexedSetter i a b c d = ReifyIndexedSetter { reflectIndexedSetter :: IndexedSetter i a b c d }++-- | @type 'SimpleIndexedSetter' i = 'Simple' ('ReifiedIndexedSetter' i)@+type SimpleReifiedIndexedSetter i a b = ReifiedIndexedSetter i a a b b+
src/Control/Lens/IndexedTraversal.hs view
@@ -17,6 +17,13 @@   (   -- * Indexed Traversals     IndexedTraversal++  -- * Common Indexed Traversals+  , traverseAt+  , iwhereOf+  , value++  -- * Indexed Traversal Combinators   , itraverseOf   , iforOf   , imapMOf@@ -24,15 +31,21 @@   , imapAccumROf   , imapAccumLOf +  -- * Storing Indexed Traversals+  , ReifiedIndexedTraversal(..)+   -- * Simple   , SimpleIndexedTraversal+  , SimpleReifiedIndexedTraversal   ) where  import Control.Applicative import Control.Applicative.Backwards import Control.Lens.Indexed+import Control.Lens.IndexedLens import Control.Lens.Type import Control.Monad.Trans.State.Lazy as Lazy+import Data.Traversable  ------------------------------------------------------------------------------ -- Indexed Traversals@@ -55,12 +68,12 @@ -- -- @ -- 'itraverseOf' = 'withIndex'--- 'Control.Lens.Traversal.traverseOf' = 'itraverseOf' . 'const' = 'id'+-- 'Control.Lens.Traversal.traverseOf' l = 'itraverseOf' l . 'const' = 'id' -- @ -- -- @--- itraverseOf :: 'Control.Lens.IndexedLens.IndexedLens' i a b c d      -> (i -> c -> f d) -> a -> f b--- itraverseOf :: 'IndexedTraversal' i a b c d -> (i -> c -> f d) -> a -> f b+-- 'itraverseOf' :: 'Control.Lens.IndexedLens.IndexedLens' i a b c d      -> (i -> c -> f d) -> a -> f b+-- 'itraverseOf' :: 'IndexedTraversal' i a b c d -> (i -> c -> f d) -> a -> f b -- @ itraverseOf :: Overloaded (Index i) f a b c d -> (i -> c -> f d) -> a -> f b itraverseOf = withIndex@@ -74,8 +87,8 @@ -- @'iforOf' = 'flip' . 'itraverseOf'@ -- -- @--- iforOf :: 'Control.Lens.IndexedLens.IndexedLens' i a b c d      -> a -> (i -> c -> f d) -> f b--- iforOf :: 'IndexedTraversal' i a b c d -> a -> (i -> c -> f d) -> f b+-- 'iforOf' :: 'Control.Lens.IndexedLens.IndexedLens' i a b c d      -> a -> (i -> c -> f d) -> f b+-- 'iforOf' :: 'IndexedTraversal' i a b c d -> a -> (i -> c -> f d) -> f b -- @ iforOf :: Overloaded (Index i) f a b c d -> a -> (i -> c -> f d) -> f b iforOf = flip . withIndex@@ -87,11 +100,11 @@ -- -- When you don't need access to the index 'mapMOf' is more liberal in what it can accept. ----- @'Control.Lens.Traversal.mapMOf' = 'imapMOf' . 'const'@+-- @'Control.Lens.Traversal.mapMOf' l = 'imapMOf' l . 'const'@ -- -- @--- imapMOf :: 'Monad' m => 'Control.Lens.IndexedLens.IndexedLens'      i a b c d -> (i -> c -> m d) -> a -> m b--- imapMOf :: 'Monad' m => 'IndexedTraversal' i a b c d -> (i -> c -> m d) -> a -> m b+-- 'imapMOf' :: 'Monad' m => 'Control.Lens.IndexedLens.IndexedLens'      i a b c d -> (i -> c -> m d) -> a -> m b+-- 'imapMOf' :: 'Monad' m => 'IndexedTraversal' i a b c d -> (i -> c -> m d) -> a -> m b -- @ imapMOf :: Overloaded (Index i) (WrappedMonad m) a b c d -> (i -> c -> m d) -> a -> m b imapMOf l f = unwrapMonad . withIndex l (\i -> WrapMonad . f i)@@ -107,8 +120,8 @@ -- @ -- -- @--- iforMOf :: 'Monad' m => 'Control.Lens.IndexedLens.IndexedLens' i a b c d      -> a -> (i -> c -> m d) -> m b--- iforMOf :: 'Monad' m => 'IndexedTraversal' i a b c d -> a -> (i -> c -> m d) -> m b+-- 'iforMOf' :: 'Monad' m => 'Control.Lens.IndexedLens.IndexedLens' i a b c d      -> a -> (i -> c -> m d) -> m b+-- 'iforMOf' :: 'Monad' m => 'IndexedTraversal' i a b c d -> a -> (i -> c -> m d) -> m b -- @ iforMOf :: Overloaded (Index i) (WrappedMonad m) a b c d -> a -> (i -> c -> m d) -> m b iforMOf = flip . imapMOf@@ -121,8 +134,8 @@ -- @'Control.Lens.Traversal.mapAccumROf' l = 'imapAccumROf' l . 'const'@ -- -- @--- imapAccumROf :: 'Control.Lens.IndexedLens.IndexedLens' i a b c d      -> (i -> s -> c -> (s, d)) -> s -> a -> (s, b)--- imapAccumROf :: 'IndexedTraversal' i a b c d -> (i -> s -> c -> (s, d)) -> s -> a -> (s, b)+-- 'imapAccumROf' :: 'Control.Lens.IndexedLens.IndexedLens' i a b c d      -> (i -> s -> c -> (s, d)) -> s -> a -> (s, b)+-- 'imapAccumROf' :: 'IndexedTraversal' i a b c d -> (i -> s -> c -> (s, d)) -> s -> a -> (s, b) -- @ imapAccumROf :: Overloaded (Index i) (Lazy.State s) a b c d -> (i -> s -> c -> (s, d)) -> s -> a -> (s, b) imapAccumROf l f s0 a = swap (Lazy.runState (withIndex l (\i c -> Lazy.state (\s -> swap (f i s c))) a) s0)@@ -135,8 +148,8 @@ -- @'Control.Lens.Traversal.mapAccumLOf' l = 'imapAccumLOf' l . 'const'@ -- -- @--- imapAccumLOf :: 'Control.Lens.IndexedLens.IndexedLens' i a b c d      -> (i -> s -> c -> (s, d)) -> s -> a -> (s, b)--- imapAccumLOf :: 'IndexedTraversal' i a b c d -> (i -> s -> c -> (s, d)) -> s -> a -> (s, b)+-- 'imapAccumLOf' :: 'Control.Lens.IndexedLens.IndexedLens' i a b c d      -> (i -> s -> c -> (s, d)) -> s -> a -> (s, b)+-- 'imapAccumLOf' :: 'IndexedTraversal' i a b c d -> (i -> s -> c -> (s, d)) -> s -> a -> (s, b) -- @ imapAccumLOf :: Overloaded (Index i) (Backwards (Lazy.State s)) a b c d -> (i -> s -> c -> (s, d)) -> s -> a -> (s, b) imapAccumLOf l f s0 a = swap (Lazy.runState (forwards (withIndex l (\i c -> Backwards (Lazy.state (\s -> swap (f i s c)))) a)) s0)@@ -146,3 +159,48 @@ swap (a,b) = (b,a) {-# INLINE swap #-} +------------------------------------------------------------------------------+-- Common Indexed Traversals+------------------------------------------------------------------------------++-- | Access the element of an 'IndexedTraversal' where the index matches a predicate.+--+-- Attempts to access beyond the range of the 'Traversal' will cause an error.+--+-- >>> :m + Control.Lens+-- >>> over (iwhereOf (indexed traverse) (>0)) reverse $ ["He","was","stressed","o_O"]+-- ["He","saw","desserts","O_o"]+--+-- @+-- 'iwhereOf' :: 'IndexedFold' i a b            -> (i -> 'Bool') -> 'IndexedFold' i a b+-- 'iwhereOf' :: 'IndexedGetter' i a b          -> (i -> 'Bool') -> 'IndexedFold' i a b+-- 'iwhereOf' :: 'SimpleIndexedLens' i a b      -> (i -> 'Bool') -> 'SimpleIndexedTraversal' i a b+-- 'iwhereOf' :: 'SimpleIndexedTraversal' i a b -> (i -> 'Bool') -> 'SimpleIndexedTraversal' i a b+-- 'iwhereOf' :: 'SimpleIndexedSetter' i a b    -> (i -> 'Bool') -> 'SimpleIndexedSetter' i a b+-- @+iwhereOf :: (Indexed i k, Applicative f) => Overloaded (Index i) f a b c c -> (i -> Bool) -> Overloaded k f a b c c+iwhereOf l p = index $ \f a -> withIndex l (\i c -> if p i then f i c else pure c) a+{-# INLINE iwhereOf #-}++-- | Traverse the value at a given key in a map+--+-- @'traverseAt' k = 'at' k '<.' 'traverse'@+traverseAt :: At k m => k -> SimpleIndexedTraversal k (m v) v+traverseAt k = at k <. traverse+{-# INLINE traverseAt #-}++-- | This provides a 'Traversal' that checks a predicate on a key before+-- allowing you to traverse into a value.+value :: (k -> Bool) -> SimpleIndexedTraversal k (k, v) v+value p = index $ \ f kv@(k,v) -> if p k then (,) k <$> f k v else pure kv+{-# INLINE value #-}++------------------------------------------------------------------------------+-- Reifying Indexed Traversals+------------------------------------------------------------------------------++-- | Useful for storage.+newtype ReifiedIndexedTraversal i a b c d = ReifyIndexedTraversal { reflectIndexedTraversal :: IndexedTraversal i a b c d }++-- | @type 'SimpleIndexedTraversal' i = 'Simple' ('ReifiedIndexedTraversal' i)@+type SimpleReifiedIndexedTraversal i a b = ReifiedIndexedTraversal i a a b b
src/Control/Lens/Internal.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-}@@ -21,7 +23,7 @@ module Control.Lens.Internal   (   -- * Implementation details-    IndexedStore(..)+    Context(..)   , Focusing(..)   , FocusingWith(..)   , FocusingPlus(..)@@ -30,14 +32,14 @@   , FocusingMay(..), May(..)   , Traversed(..)   , Sequenced(..)-  , AppliedState(..)+  , Indexing(..), IndexingResult(..)   , Min(..)   , getMin   , Max(..)   , getMax   , ElementOf(..)   , ElementOfResult(..)-  , Kleene(..), kleene+  , Bazaar(..), bazaar, duplicateBazaar, sell   , Effect(..)   , EffectRWS(..)   -- , EffectS(..)@@ -45,10 +47,11 @@   , Settable(..), Mutator(..)   ) where - import Control.Applicative import Control.Applicative.Backwards import Control.Category+import Control.Comonad+import Control.Comonad.Store.Class import Control.Lens.Isomorphic import Control.Monad import Prelude hiding ((.),id)@@ -150,25 +153,47 @@  -- | The indexed store can be used to characterize a 'Control.Lens.Type.Lens' -- and is used by 'Control.Lens.Type.clone'-data IndexedStore c d a = IndexedStore (d -> a) c+data Context c d a = Context (d -> a) c -instance Functor (IndexedStore c d) where-  fmap f (IndexedStore g c) = IndexedStore (f . g) c+instance Functor (Context c d) where+  fmap f (Context g c) = Context (f . g) c +instance (c ~ d) => Comonad (Context c d) where+  extract   (Context f c) = f c+  duplicate (Context f c) = Context (Context f) c+  extend g  (Context f c) = Context (g . Context f) c++instance (c ~ d) => ComonadStore c (Context c d) where+  pos (Context _ c) = c+  peek c (Context g _) = g c+  peeks f (Context g c) = g (f c)+  seek c (Context g _) = Context g c+  seeks f (Context g c) = Context g (f c)+  experiment f (Context g c) = g <$> f c++-- | The result of 'Indexing'+data IndexingResult f a = IndexingResult (f a) {-# UNPACK #-} !Int++instance Functor f => Functor (IndexingResult f) where+  fmap f (IndexingResult fa n) = IndexingResult (fmap f fa) n+ -- | Applicative composition of @'Control.Monad.Trans.State.Lazy.State' 'Int'@ with a 'Functor', used--- by 'Control.Lens.Traversal.elementOf', 'Control.Lens.Traversal.elementsOf', 'Control.Lens.Traversal.traverseElement', 'Control.Lens.Traversal.traverseElementsOf'-newtype AppliedState f a = AppliedState { runAppliedState :: Int -> (f a, Int) }+-- by 'Control.Lens.Indexed.indexed'+newtype Indexing f a = Indexing { runIndexing :: Int -> IndexingResult f a } -instance Functor f => Functor (AppliedState f) where-  fmap f (AppliedState m) = AppliedState $ \i -> case m i of-    (fa, j) -> (fmap f fa, j)+instance Functor f => Functor (Indexing f) where+  fmap f (Indexing m) = Indexing $ \i -> fmap f (m i) -instance Applicative f => Applicative (AppliedState f) where-  pure a = AppliedState (\i -> (pure a, i))-  AppliedState mf <*> AppliedState ma = AppliedState $ \i -> case mf i of-    (ff, j) -> case ma j of-       (fa, k) -> (ff <*> fa, k)+instance Applicative f => Applicative (Indexing f) where+  pure = Indexing . IndexingResult . pure+  Indexing mf <*> Indexing ma = Indexing $ \i -> case mf i of+    IndexingResult ff j -> case ma j of+       IndexingResult fa k -> IndexingResult (ff <*> fa) k +instance Gettable f => Gettable (Indexing f) where+  coerce (Indexing m) = Indexing $ \i -> case m i of+    IndexingResult ff j -> IndexingResult (coerce ff) j+ -- | Used internally by 'Control.Lens.Traversal.traverseOf_' and the like. newtype Traversed f = Traversed { getTraversed :: f () } @@ -245,29 +270,51 @@     NotFound e -> NotFound e  --- | The "Indexed Kleene Store comonad", aka the 'indexed cartesian store comonad' or an indexed 'FunList'.+-- | This is used to characterize a 'Control.Lens.Traversal.Traversal'. ----- This is used to characterize a 'Control.Lens.Traversal.Traversal'.+-- a.k.a. indexed Cartesian store comonad, indexed Kleene store comonad, or an indexed 'FunList'. -- -- <http://twanvl.nl/blog/haskell/non-regular1>-data Kleene c d a-  = Done a-  | More (Kleene c d (d -> a)) c+--+-- Mnemonically, a 'Bazaar' holds many stores and you can easily add more.+--+-- This is a final encoding of 'Bazaar'.+newtype Bazaar c d a = Bazaar { _runBazaar :: forall f. Applicative f => (c -> f d) -> f a } -instance Functor (Kleene c d) where-  fmap f (Done a) = Done (f a)-  fmap f (More k b) = More (fmap (f .) k)  b+instance Functor (Bazaar c d) where+  fmap f (Bazaar k) = Bazaar (fmap f . k) -instance Applicative (Kleene c d) where-  pure = Done-  Done f   <*> m = fmap f m-  More k c <*> m = More (flip <$> k <*> m) c+instance Applicative (Bazaar c d) where+  pure a = Bazaar (\_ -> pure a)+  {-# INLINE pure #-}+  Bazaar mf <*> Bazaar ma = Bazaar (\k -> mf k <*> ma k)+  {-# INLINE (<*>) #-} --- | Given an action to run for each matched pair, traverse a store.-kleene :: Applicative f => (c -> f d) -> Kleene c d b -> f b-kleene _ (Done b) = pure b-kleene f (More k c) = f c <**> kleene f k+instance (c ~ d) => Comonad (Bazaar c d) where+  extract (Bazaar m) = runIdentity (m Identity)+  {-# INLINE extract #-}+  duplicate = duplicateBazaar+  {-# INLINE duplicate #-} +-- | Given an action to run for each matched pair, traverse a bazaar.+bazaar :: Applicative f => (c -> f d) -> Bazaar c d b -> f b+bazaar cfd (Bazaar m) = m cfd+{-# INLINE bazaar #-}++-- | 'Bazaar' is an indexed 'Comonad'.+duplicateBazaar :: Bazaar c e a -> Bazaar c d (Bazaar d e a)+duplicateBazaar (Bazaar m) = getCompose (m (Compose . fmap sell . sell))+{-# INLINE duplicateBazaar #-}+-- duplicateBazaar' (Bazaar m) = Bazaar (\g -> getCompose (m (Compose . fmap sell . g)))++-- | A trivial 'Bazaar'.+sell :: c -> Bazaar c d d+sell i = Bazaar (\k -> k i)+{-# INLINE sell #-}++instance (c ~ d) => ComonadApply (Bazaar c d) where+  (<@>) = (<*>)+ -- | Wrap a monadic effect with a phantom type argument. newtype Effect m r a = Effect { getEffect :: m r } @@ -428,4 +475,39 @@   pure = Mutator   Mutator f <*> Mutator a = Mutator (f a) +{-+data Bazaar c d a+  = Buy a+  | Trade (Bazaar c d (d -> a)) c +instance Functor (Bazaar c d) where+  fmap f (Buy a)    = Buy (f a)+  fmap f (Trade k b) = Trade (fmap (f .) k)  b++instance Applicative (Bazaar c d) where+  pure            = Buy+  Buy f     <*> m = fmap f m+  Trade k c <*> m = Trade (flip <$> k <*> m) c++instance (c ~ d) => Comonad (Bazaar c d) where+  extract (Buy a)     = a+  extract (Trade z c) = extract z c+  duplicate = duplicateBazaar++-- | 'Bazaar' is an indexed 'Comonad'.+duplicateBazaar :: Bazaar c e a -> Bazaar c d (Bazaar d e a)+duplicateBazaar (Buy b)     = Buy (Buy b)+duplicateBazaar (Trade z c) = Trade (Trade <$> duplicateBazaar z) c++-- | A trivial 'Bazaar'.+sell :: c -> Bazaar c d d+sell = Trade (Buy id)++instance (c ~ d) => ComonadApply (Bazaar c d) where+  (<@>) = (<*>)++-- | Given an action to run for each matched pair, traverse a bazaar.+bazaar :: Applicative f => (c -> f d) -> Bazaar c d b -> f b+bazaar _ (Buy b)    = pure b+bazaar f (Trade k c) = f c <**> bazaar f k+-}
src/Control/Lens/Iso.hs view
@@ -26,8 +26,11 @@   -- ** Common Isomorphisms   , _const   , identity+  -- * Storing Isomorphisms+  , ReifiedIso(..)   -- * Simplicity   , SimpleIso+  , SimpleReifiedIso   ) where  import Control.Applicative@@ -146,3 +149,13 @@ _const :: Iso a b (Const a c) (Const b d) _const = isos Const getConst Const getConst {-# INLINE _const #-}++-----------------------------------------------------------------------------+-- Reifying Isomorphisms+-----------------------------------------------------------------------------++-- | Useful for storing isomorphisms in containers.+newtype ReifiedIso a b c d = ReifyIso { reflectIso :: Iso a b c d }++-- | @type SimpleReifiedIso = 'Control.Lens.Type.Simple' 'ReifiedIso'@+type SimpleReifiedIso a b = ReifiedIso a a b b
+ src/Control/Lens/Plated.hs view
@@ -0,0 +1,837 @@+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+-------------------------------------------------------------------------------+-- |+-- Module      :  Control.Lens.Plated+-- Copyright   :  (C) 2012 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  Rank2Types+--+-- The name \"plate\" stems originally from \"boilerplate\", which was the term+-- used by the \"Scrap Your Boilerplate\" papers, and later inherited by Neil+-- Mitchell's \"Uniplate\".+--+-- <http://community.haskell.org/~ndm/uniplate/>+--+-- The combinators in here are designed to be compatible with and subsume the+-- 'uniplate' API with the notion of a 'Traversal' replacing a uniplate or+-- biplate.+--+-- By implementing these combinators in terms of 'plate' instead of 'uniplate'+-- additional type safety is gained, as the user is no longer responsible for+-- maintaining invariants such as the number of children he received.+--+-- Note: The @Biplate@ is /deliberately/ excluded from the API here, with the+-- intention that you replace them with either explicit traversals, or by using the+-- @On@ variants of the combinators below with 'Data.Data.Lens.biplate' from+-- @Data.Data.Lens@. As a design, it forced the user into too many situations where+-- they had to choose between correctness and ease of use, and it was brittle in the+-- face of competing imports.+--+-- The sensible use of these combinators makes some simple assumptions.  Notably, any+-- of the @On@ combinators are expecting a 'Traversal', 'Setter' or 'Fold'+-- to play the role of the 'Data.Data.Lens.biplate' combinator, and so when the+-- types of the contents and the container match, they should be the 'id' 'Traversal',+-- 'Setter' or 'Fold'.+--+-- It is often beneficial to use the combinators in this module with the combinators+-- from @Data.Data.Lens@ or @GHC.Generics.Lens@ to make it easier to automatically+-- derive definitions for 'plate', or to derive custom traversals.+-------------------------------------------------------------------------------+module Control.Lens.Plated+  (+  -- * Uniplate+    Plated(..)++  -- * Uniplate Combinators+  , children, childrenOn+  , rewrite, rewriteOf, rewriteOn, rewriteOnOf+  , rewriteM, rewriteMOf, rewriteMOn, rewriteMOnOf+  , universe, universeOf, universeOn, universeOnOf+  , transform, transformOf, transformOn, transformOnOf+  , transformM, transformMOf, transformMOn, transformMOnOf+  , descend, descendOf, descendOn, descendOnOf+  , descendA, descendAOf, descendAOn, descendAOnOf+  , descendA_, descendAOf_, descendAOn_, descendAOnOf_+  , descendM, descendMOf, descendMOn, descendMOnOf+  , descendM_, descendMOf_, descendMOn_, descendMOnOf_+  , contexts, contextsOf, contextsOn, contextsOnOf+  , holes, holesOf, holesOn, holesOnOf+  , para, paraOf++  -- * Compos+  -- $compos+  , composOpFold++  -- * Parts+  , parts+  , partsOf++  -- ** Unsafe Operations+  , unsafePartsOf+  )+  where++import Control.Applicative+import Control.Lens.Fold+import Control.Lens.Getter+import Control.Lens.Internal+import Control.Lens.Setter+import Control.Lens.Traversal+import Control.Lens.Type+import Data.Tree++-- | A 'Plated' type is one where we know how to extract its immediate self-similar children.+--+-- /Example 1/:+--+-- @+-- import Control.Applicative+-- import Control.Lens+-- import Control.Plated+-- import Data.Data+-- import Data.Data.Lens ('Data.Data.Lens.uniplate')+-- @+--+-- @+-- data Expr+--   = Val 'Int'+--   | Neg Expr+--   | Add Expr Expr+--   deriving ('Eq','Ord','Show','Read','Data','Typeable')+-- @+--+-- @+-- instance 'Plated' Expr where+--   'plate' f (Neg e) = Neg '<$>' f e+--   'plate' f (Add a b) = Add '<$>' f a '<*>' f b+--   'plate' _ a = 'pure' a+-- @+--+-- /or/+--+-- @+-- instance 'Plated' Expr where+--   'plate' = 'Data.Data.Lens.uniplate'+-- @+--+-- /Example 2/:+--+-- @+-- import Control.Applicative+-- import Control.Lens+-- import Control.Plated+-- import Data.Data+-- import Data.Data.Lens ('Data.Data.Lens.uniplate')+-- @+--+-- @+-- data Tree a+--   = Bin (Tree a) (Tree a)+--   | Tip a+--   deriving ('Eq','Ord','Show','Read','Data','Typeable')+-- @+--+-- @+-- instance 'Plated' (Tree a) where+--   'plate' f (Bin l r) = Bin '<$>' f l '<*>' f r+--   'plate' _ t = 'pure' t+-- @+--+-- /or/+--+-- @+-- instance 'Data' a => 'Plated' (Tree a) where+--   'plate' = 'uniplate'+-- @+--+-- Note the big distinction between these two implementations.+--+-- The former will only treat children directly in this tree as descendents,+-- the latter will treat trees contained in the values under the tips also+-- as descendants!+--+-- When in doubt, pick a 'Traversal' and just use the various @...Of@ combinators+-- rather than pollute 'Plated' with orphan instances!+--+-- If you want to find something unplated and non-recursive with 'Data.Data.Lens.biplate'+-- use the @...OnOf@ variant with 'ignored', though those usecases are much better served+-- in most cases by using the existing lens combinators! e.g.+--+-- @'toListOf' 'biplate' = 'universeOnOf' 'biplate' 'ignored'@.+--+-- This same ability to explicitly pass the 'Traversal' in question is why there is no+-- analogue to uniplate's @Biplate@.+--+-- Moreover, since we can allow custom traversals, we implement reasonable defaults for+-- polymorphic data types, that only traverse into themselves, and /not/ their+-- polymorphic arguments.++class Plated a where+  -- | 'Traversal' of the immediate children of this structure.+  --+  -- The default definition finds no children.+  plate :: Simple Traversal a a+  plate = ignored++instance Plated [a] where+  plate f (x:xs) = (x:) <$> f xs+  plate _ [] = pure []++instance Plated (Tree a) where+  plate f (Node a as) = Node a <$> traverse f as++-------------------------------------------------------------------------------+-- Children+-------------------------------------------------------------------------------++-- | Extract the immediate descendants of a 'Plated' container.+--+-- @'children' = 'toListOf' 'plate'@+children :: Plated a => a -> [a]+children = toListOf plate+{-# INLINE children #-}++-- | Provided for compatibility with @uniplate@.+--+-- @'childrenOn' = 'toListOf'@+--+-- @'childrenOn' :: 'Fold' a b -> a -> [b]@+childrenOn :: Getting [b] a b -> a -> [b]+childrenOn = toListOf+{-# INLINE childrenOn #-}++-------------------------------------------------------------------------------+-- Rewriting+-------------------------------------------------------------------------------++-- | Rewrite by applying a rule everywhere you can. Ensures that the rule cannot+-- be applied anywhere in the result:+--+-- @propRewrite r x = 'all' ('Data.Just.isNothing' . r) ('universe' ('rewrite' r x))@+--+-- Usually 'transform' is more appropriate, but 'rewrite' can give better+-- compositionality. Given two single transformations @f@ and @g@, you can+-- construct @\a -> f a `mplus` g a@ which performs both rewrites until a fixed point.+rewrite :: Plated a => (a -> Maybe a) -> a -> a+rewrite = rewriteOf plate+{-# INLINE rewrite #-}++-- | Rewrite by applying a rule everywhere you can. Ensures that the rule cannot+-- be applied anywhere in the result:+--+-- @propRewriteOf l r x = 'all' ('Data.Just.isNothing' . r) ('universeOf' l ('rewriteOf' l r x))@+--+-- Usually 'transformOf' is more appropriate, but 'rewriteOf' can give better+-- compositionality. Given two single transformations @f@ and @g@, you can+-- construct @\a -> f a `mplus` g a@ which performs both rewrites until a fixed point.+--+-- @+-- 'rewriteOf' :: 'Simple' 'Control.Lens.Iso.Iso' a a       -> (a -> 'Maybe' a) -> a -> a+-- 'rewriteOf' :: 'Simple' 'Lens' a a      -> (a -> 'Maybe' a) -> a -> a+-- 'rewriteOf' :: 'Simple' 'Traversal' a a -> (a -> 'Maybe' a) -> a -> a+-- 'rewriteOf' :: 'Simple' 'Setter' a a    -> (a -> 'Maybe' a) -> a -> a+-- @+rewriteOf :: SimpleSetting a a -> (a -> Maybe a) -> a -> a+rewriteOf l f = go where+  go = transformOf l (\x -> maybe x go (f x))+{-# INLINE rewriteOf #-}++-- | Rewrite recursively over part of a larger structure.+--+-- @+-- 'rewriteOn' :: 'Plated' c => 'Simple' 'Control.Lens.Iso.Iso' a b       -> (b -> 'Maybe' b) -> a -> a+-- 'rewriteOn' :: 'Plated' c => 'Simple' 'Lens' a b      -> (b -> 'Maybe' b) -> a -> a+-- 'rewriteOn' :: 'Plated' c => 'Simple' 'Traversal' a b -> (b -> 'Maybe' b) -> a -> a+-- 'rewriteOn' :: 'Plated' c => 'Simple' 'Setting' a b   -> (b -> 'Maybe' b) -> a -> a+-- @+rewriteOn :: Plated c => Setting a b c c -> (c -> Maybe c) -> a -> b+rewriteOn b = over b . rewrite+{-# INLINE rewriteOn #-}++-- | Rewrite recursively over part of a larger structure using a specified setter.+--+-- @+-- 'rewriteOnOf' :: 'Plated' b => 'Simple' 'Control.Lens.Iso.Iso' a b       -> 'Simple' 'Control.Lens.Iso.Iso' b b       -> (b -> 'Maybe' b) -> a -> a+-- 'rewriteOnOf' :: 'Plated' b => 'Simple' 'Lens' a b      -> 'Simple' 'Lens' b b      -> (b -> 'Maybe' b) -> a -> a+-- 'rewriteOnOf' :: 'Plated' b => 'Simple' 'Traversal' a b -> 'Simple' 'Traversal' b b -> (b -> 'Maybe' b) -> a -> a+-- 'rewriteOnOf' :: 'Plated' b => 'Simple' 'Setter' a b    -> 'Simple' 'Setter' b b    -> (b -> 'Maybe' b) -> a -> a+-- @+rewriteOnOf :: Setting a b c c -> SimpleSetting c c -> (c -> Maybe c) -> a -> b+rewriteOnOf b l = over b . rewriteOf l+{-# INLINE rewriteOnOf #-}++-- | Rewrite by applying a monadic rule everywhere you can. Ensures that the rule cannot+-- be applied anywhere in the result.+rewriteM :: (Monad m, Plated a) => (a -> m (Maybe a)) -> a -> m a+rewriteM = rewriteMOf plate+{-# INLINE rewriteM #-}++-- | Rewrite by applying a monadic rule everywhere you recursing with a user-specified 'Traversal'.+-- Ensures that the rule cannot be applied anywhere in the result.+rewriteMOf :: Monad m => SimpleLensLike (WrappedMonad m) a a -> (a -> m (Maybe a)) -> a -> m a+rewriteMOf l f = go where+  go = transformMOf l (\x -> f x >>= maybe (return x) go)+{-# INLINE rewriteMOf #-}++-- | Rewrite by applying a monadic rule everywhere inside of a structure located by a user-specified 'Traversal'.+-- Ensures that the rule cannot be applied anywhere in the result.+rewriteMOn :: (Monad m, Plated c) => LensLike (WrappedMonad m) a b c c -> (c -> m (Maybe c)) -> a -> m b+rewriteMOn b = mapMOf b . rewriteM+{-# INLINE rewriteMOn #-}++-- | Rewrite by applying a monadic rule everywhere inside of a structure located by a user-specified 'Traversal',+-- using a user-specified 'Traversal' for recursion. Ensures that the rule cannot be applied anywhere in the result.+rewriteMOnOf :: Monad m => LensLike (WrappedMonad m) a b c c -> SimpleLensLike (WrappedMonad m) c c -> (c -> m (Maybe c)) -> a -> m b+rewriteMOnOf b l = mapMOf b . rewriteMOf l+{-# INLINE rewriteMOnOf #-}++-------------------------------------------------------------------------------+-- Universe+-------------------------------------------------------------------------------++-- | Retrieve all of the transitive descendants of a 'Plated' container, including itself.+universe :: Plated a => a -> [a]+universe = universeOf plate+{-# INLINE universe #-}++-- | Given a fold that knows how to locate immediate children, retrieve all of the transitive descendants of a node, including itself.+--+-- @'universeOf' :: 'Fold' a a -> a -> [a]@+universeOf :: Getting [a] a a -> a -> [a]+universeOf l = go where+  go a = a : foldMapOf l go a+{-# INLINE universeOf #-}++-- | Given a 'Fold' that knows how to find 'Plated' parts of a container retrieve them and all of their descendants, recursively.+universeOn ::  Plated b => Getting [b] a b -> a -> [b]+universeOn b = universeOnOf b plate+{-# INLINE universeOn #-}++-- | Given a 'Fold' that knows how to locate immediate children, retrieve all of the transitive descendants of a node, including itself that lie+-- in a region indicated by another 'Fold'.+--+-- @'toListOf' l = 'universeOnOf' l 'ignored'@+universeOnOf :: Getting [b] a b -> Getting [b] b b -> a -> [b]+universeOnOf b = foldMapOf b . universeOf+{-# INLINE universeOnOf #-}++-------------------------------------------------------------------------------+-- Transformation+-------------------------------------------------------------------------------++-- | Transform every element in the tree, in a bottom-up manner.+--+-- For example, replacing negative literals with literals:+--+-- @+-- negLits = 'transform' $ \x -> case x of+--   Neg (Lit i) -> Lit ('negate' i)+--   _           -> x+-- @+transform :: Plated a => (a -> a) -> a -> a+transform = transformOf plate+{-# INLINE transform #-}++-- | Transform every element in the tree in a bottom-up manner over a region indicated by a 'Setter'.+--+-- @+-- 'transformOn' :: 'Plated' b => 'Simple' 'Traversal' a b -> (b -> b) -> a -> a+-- 'transformOn' :: 'Plated' b => 'Simple' 'Setter' a b    -> (b -> b) -> a -> a+-- @+transformOn :: Plated c => Setting a b c c -> (c -> c) -> a -> b+transformOn b = over b . transform+{-# INLINE transformOn #-}++-- | Transform every element by recursively applying a given 'Setter' in a bottom-up manner.+--+-- @+-- 'transformOf' :: 'Simple' 'Traversal' a a -> (a -> a) -> a -> a+-- 'transformOf' :: 'Simple' 'Setter' a a    -> (a -> a) -> a -> a+-- @+transformOf :: SimpleSetting a a -> (a -> a) -> a -> a+transformOf l f = go where+  go = f . over l go+{-# INLINE transformOf #-}++-- | Transform every element in a region indicated by a 'Setter' by recursively applying another 'Setter'+-- in a bottom-up manner.+--+-- @+-- 'transformOnOf' :: 'Setter' a b -> 'Simple' 'Traversal' b b -> (b -> b) -> a -> a+-- 'transformOnOf' :: 'Setter' a b -> 'Simple' 'Setter' b b    -> (b -> b) -> a -> a+-- @+transformOnOf :: Setting a b c c -> SimpleSetting c c -> (c -> c) -> a -> b+transformOnOf b l = over b . transformOf l+{-# INLINE transformOnOf #-}++-- | Transform every element in the tree, in a bottom-up manner, monadically.+transformM :: (Monad m, Plated a) => (a -> m a) -> a -> m a+transformM = transformMOf plate+{-# INLINE transformM #-}++-- | Transform every element in the tree in a region indicated by a supplied 'Traversal', in a bottom-up manner, monadically.+--+-- @'transformMOn' :: ('Monad' m, 'Plated' c) => 'Simple' 'Traversal' a b -> (b -> m b) -> a -> m a@+transformMOn :: (Monad m, Plated c) => LensLike (WrappedMonad m) a b c c -> (c -> m c) -> a -> m b+transformMOn b = mapMOf b . transformM+{-# INLINE transformMOn #-}++-- | Transform every element in a tree using a user supplied 'Traversal' in a bottom-up manner with a monadic effect.+--+-- @'transformMOf' :: 'Monad' m => 'Simple 'Traversal' a a -> (a -> m a) -> a -> m a@+transformMOf :: Monad m => SimpleLensLike (WrappedMonad m) a a -> (a -> m a) -> a -> m a+transformMOf l f = go where+  go t = mapMOf l go t >>= f+{-# INLINE transformMOf #-}++-- | Transform every element in a tree that lies in a region indicated by a supplied 'Traversal', walking with a user supplied 'Traversal' in+-- a bottom-up manner with a monadic effect.+--+-- @'transformMOnOf' :: 'Monad' m => 'Simple' 'Traversal' a b -> 'Simple' 'Traversal' b b -> (b -> m b) -> a -> m a@+transformMOnOf :: Monad m => LensLike (WrappedMonad m) a b c c -> SimpleLensLike (WrappedMonad m) c c -> (c -> m c) -> a -> m b+transformMOnOf b l = mapMOf b . transformMOf l+{-# INLINE transformMOnOf #-}++-------------------------------------------------------------------------------+-- Descent+-------------------------------------------------------------------------------++-- | Recurse one level into a structure. (a.k.a @composOp@ from Björn Bringert's @compos@)+--+-- @'descend' = 'over' 'plate'@+descend :: Plated a => (a -> a) -> a -> a+descend = over plate+{-# INLINE descend #-}++-- | Recurse one level into a structure using a user specified recursion scheme. This is 'over', but it is supplied here+-- for consistency with the uniplate API.+--+-- @'descendOf' = 'over'@+--+-- @+-- 'descendOf' :: 'Simple' 'Setter' a b -> (b -> b) -> a -> a+-- 'descendOf' :: 'Simple' 'Traversal' a b -> (b -> b) -> a -> a+-- @+descendOf :: Setting a b c d -> (c -> d) -> a -> b+descendOf = over+{-# INLINE descendOf #-}++-- | Recurse one level into the parts delimited by one 'Setter', using another.+--+-- @'descendOnOf' b l = 'over' (b '.' l)@+--+-- @+-- 'descendOnOf' :: 'Simple' 'Setter' a b    -> 'Simple' 'Setter' b b    -> (b -> b) -> a -> a+-- 'descendOnOf' :: 'Simple' 'Traversal' a b -> 'Simple' 'Traversal' b b -> (b -> b) -> a -> a+-- @+--+descendOnOf :: Setting a b c d -> Setting c d e f -> (e -> f) -> a -> b+descendOnOf b l = over (b.l)+{-# INLINE descendOnOf #-}++-- | Recurse one level into the parts of the structure delimited by a 'Setter'.+--+-- @'descendOn' b = 'over' (b '.' 'plate')@+--+-- @'descendOn' :: 'Plated' c => 'Setter' a b -> (b -> b) -> a -> a@+descendOn :: Plated c => Setting a b c c -> (c -> c) -> a -> b+descendOn b = over (b . plate)+{-# INLINE descendOn #-}++-------------------------------------------------------------------------------+-- Applicative Descent+-------------------------------------------------------------------------------++-- | Recurse one level into a structure with an 'Applicative' effect, this is 'plate', but it is supplied+-- for consistency with the uniplate API.+--+-- @'descendA' = 'plate'@+descendA :: (Applicative f, Plated a) => (a -> f a) -> a -> f a+descendA = plate+{-# INLINE descendA #-}++-- | Recurse one level into a structure using a user specified recursion scheme and 'Applicative' effects. This is 'id', but it is supplied+-- for consistency with the uniplate API.+--+-- @'descendAOf' = 'id'@+--+-- @'descendAOf' :: 'Applicative' m => 'Simple' 'Traversal' a b => (b -> m b) -> a -> m a@+descendAOf :: Applicative f => LensLike f a b c d -> (c -> f d) -> a -> f b+descendAOf = id+{-# INLINE descendAOf #-}++-- | Recurse one level into the parts delimited by one 'Traversal', using another with 'Applicative' effects.+--+-- @'descendAOnOf' = ('.')@+--+-- @'descendAOnOf' :: 'Applicative' f => 'Simple' 'Traversal' a b -> 'Simple' 'Traversal' b b -> (b -> f b) -> a -> f a@+descendAOnOf :: Applicative g => LensLike g a b c d -> LensLike g c d e f -> (e -> g f) -> a -> g b+descendAOnOf = (.)+{-# INLINE descendAOnOf #-}++-- | Recurse one level into the parts of the structure delimited by a 'Traversal' with 'Applicative' effects.+--+-- @'descendAOn' b = b '.' 'plate'@+--+-- @'descendAOn' :: ('Applicative' f, Plated' c) => 'Simple' 'Traversal' a b -> (b -> f b) -> a -> f a@+descendAOn :: (Applicative f, Plated c) => LensLike f a b c c -> (c -> f c) -> a -> f b+descendAOn b = b . plate+{-# INLINE descendAOn #-}++-- |+--+-- @'descendA_' = traverseOf_' 'plate'@+descendA_ :: (Applicative f, Plated a) => (a -> f b) -> a -> f ()+descendA_ = traverseOf_ plate+{-# INLINE descendA_ #-}++-- | Recurse one level into a structure using a user specified recursion scheme and 'Applicative' effects, without reconstructing the structure behind you.+--+-- This is just 'traverseOf_', but is provided for consistency.+--+-- @'descendAOf_' = 'traverseOf_'@+--+-- @'descendAOf_' :: 'Applicative' f => 'Fold' a b => (b -> f b) -> a -> f ()@+descendAOf_ :: Applicative f => Getting (Traversed f) a b -> (b -> f c) -> a -> f ()+descendAOf_ = traverseOf_+{-# INLINE descendAOf_ #-}++-- | Recurse one level into the parts delimited by one 'Fold', using another with 'Applicative' effects, without reconstructing the structure behind you.+--+-- @'descendAOnOf_' b l = 'traverseOf_' (b '.' l)@+--+-- @'descendAOnOf_' :: 'Applicative' f => 'Fold' a b -> 'Fold' b b -> (b -> f c) -> a -> f ()@+descendAOnOf_ :: Applicative f => Getting (Traversed f) a b -> Getting (Traversed f) b b -> (b -> f c) -> a -> f ()+descendAOnOf_ b l = traverseOf_ (b . l)+{-# INLINE descendAOnOf_ #-}++-- | Recurse one level into the parts of the structure delimited by a 'Traversal' with monadic effects.+--+-- @'descendAOn_' b = 'traverseOf_' (b '.' 'plate')@+--+-- @'descendAOn_' :: ('Applicative' f, 'Plated' b) => 'Simple' 'Traversal' a b -> (b -> f c) -> a -> f ()@+descendAOn_ :: (Applicative f, Plated b) => Getting (Traversed f) a b -> (b -> f c) -> a -> f ()+descendAOn_ b = traverseOf_ (b . plate)+{-# INLINE descendAOn_ #-}++-------------------------------------------------------------------------------+-- Monadic Descent+-------------------------------------------------------------------------------++-- | Recurse one level into a structure with a monadic effect. (a.k.a @composOpM@ from Björn Bringert's @compos@)+--+-- @'descendM' = 'mapMOf' 'plate'@+descendM :: (Monad m, Plated a) => (a -> m a) -> a -> m a+descendM = mapMOf plate+{-# INLINE descendM #-}++-- | Recurse one level into a structure using a user specified recursion scheme and monadic effects. This is 'id', but it is+-- supplied for consistency with the uniplate API.+--+-- @'descendMOf' = 'mapMOf'@+--+-- @'descendMOf' :: 'Monad' m => 'Simple' 'Traversal' a b => (b -> m b) -> a -> m a@+descendMOf :: Monad m => LensLike (WrappedMonad m) a b c d -> (c -> m d) -> a -> m b+descendMOf = mapMOf+{-# INLINE descendMOf #-}++-- | Recurse one level into the parts delimited by one 'Traversal', using another with monadic effects.+--+-- @'descendMOnOf' b l = 'mapMOf' (b '.' l)@+--+-- @'descendMOnOf' :: 'Monad' m => 'Simple' 'Traversal' a b -> 'Simple' 'Traversal' b b -> (b -> m b) -> a -> m a@+descendMOnOf :: Monad m => LensLike (WrappedMonad m) a b c c -> SimpleLensLike (WrappedMonad m) c c -> (c -> m c) -> a -> m b+descendMOnOf b l = mapMOf (b . l)+{-# INLINE descendMOnOf #-}++-- | Recurse one level into the parts of the structure delimited by a 'Traversal' with monadic effects.+--+-- @'descendMOn' b = 'mapMOf' (b . 'plate')@+--+-- @'descendMOn' :: ('Monad' m, 'Plated' c) => 'Simple' 'Traversal' a b -> (b -> m b) -> a -> m a@+descendMOn :: (Monad m, Plated c) => LensLike (WrappedMonad m) a b c c -> (c -> m c) -> a -> m b+descendMOn b = mapMOf (b . plate)+{-# INLINE descendMOn #-}++-- | Descend one level into a structure with monadic effects (a.k.a @composOpM@ from Björn Bringert's @compos@)+--+-- @'descendM_' = mapMOf_' 'plate'@+descendM_ :: (Monad m, Plated a) => (a -> m b) -> a -> m ()+descendM_ = mapMOf_ plate+{-# INLINE descendM_ #-}++-- | Recurse one level into a structure using a user specified recursion scheme and monadic effects. This is just 'mapMOf_', but is provided for consistency.+--+-- @'descendMOf_' = 'mapMOf_'@+--+-- @'descendMOf_' :: 'Monad' m => 'Fold' a b => (b -> m b) -> a -> m ()@+descendMOf_ :: Monad m => Getting (Sequenced m) a b -> (b -> m c) -> a -> m ()+descendMOf_ = mapMOf_+{-# INLINE descendMOf_ #-}++-- | Recurse one level into the parts delimited by one 'Traversal', using another with monadic effects.+--+-- @'descendMOnOf_' b l = 'mapMOf_' (b '.' l)@+--+-- @'descendMOnOf_' :: 'Monad' m => 'Fold' a b -> 'Fold' b b -> (b -> m b) -> a -> m ()@+descendMOnOf_ :: Monad m => Getting (Sequenced m) a b -> Getting (Sequenced m) b b -> (b -> m c) -> a -> m ()+descendMOnOf_ b l = mapMOf_ (b . l)+{-# INLINE descendMOnOf_ #-}++-- | Recurse one level into the parts of the structure delimited by a 'Traversal' with monadic effects.+--+-- @'descendMOn_' b = 'mapMOf_' (b '.' 'plate')@+--+-- @'descendMOn_' :: ('Monad' m, 'Plated' b) => 'Simple' 'Traversal' a b -> (b -> m c) -> a -> m ()@+descendMOn_ :: (Monad m, Plated b) => Getting (Sequenced m) a b -> (b -> m c) -> a -> m ()+descendMOn_ b = mapMOf_ (b . plate)+{-# INLINE descendMOn_ #-}++-------------------------------------------------------------------------------+-- Holes and Contexts+-------------------------------------------------------------------------------++-- | Return a list of all of the editable contexts for every location in the structure, recursively.+--+-- @+-- propUniverse x = 'universe' x == 'map' 'pos' ('contexts' x)+-- propId x = 'all' ('==' x) [extract w | w <- 'contexts' x]+-- @+--+-- @'contexts' = 'contextsOf' 'plate'@+contexts :: Plated a => a -> [Context a a a]+contexts = contextsOf plate+{-# INLINE contexts #-}++-- | Return a list of all of the editable contexts for every location in the structure, recursively, using a user-specified 'Traversal' to walk each layer.+--+-- @+-- propUniverse l x = 'universeOf' l x == 'map' 'pos' ('contextsOf' l x)+-- propId l x = 'all' ('==' x) [extract w | w <- 'contextsOf' l x]+-- @+--+-- @'contextsOf' :: 'Simple' 'Traversal' a a -> a -> ['Context' a a]@+contextsOf :: SimpleLensLike (Bazaar a a) a a -> a -> [Context a a a]+contextsOf l x = Context id x : f (holesOf l x) where+  f xs = do+    Context ctx child <- xs+    Context context y <- contextsOf l child+    return $ Context (ctx . context) y+{-# INLINE contextsOf #-}++-- | Return a list of all of the editable contexts for every location in the structure in an areas indicated by a user supplied 'Traversal', recursively using 'plate'.+--+-- @'contextsOn' b = 'contextsOnOf' b 'plate'@+--+-- @'contextsOn' :: 'Plated' b => 'Simple' 'Traversal' a b -> a -> ['Context' b b a]@+contextsOn :: Plated c => LensLike (Bazaar c c) a b c c -> a -> [Context c c b]+contextsOn b = contextsOnOf b plate+{-# INLINE contextsOn #-}++-- | Return a list of all of the editable contexts for every location in the structure in an areas indicated by a user supplied 'Traversal', recursively using+-- another user-supplied 'Traversal' to walk each layer.+--+-- @'contextsOnOf' :: 'Simple' 'Traversal' a b -> 'Simple' 'Traversal' b b -> a -> ['Context' b b a]@+contextsOnOf :: LensLike (Bazaar c c) a b c c -> SimpleLensLike (Bazaar c c) c c -> a -> [Context c c b]+contextsOnOf b l = f . holesOf b where+  f xs = do+    Context ctx child <- xs+    Context context y <- contextsOf l child+    return $ Context (ctx . context) y+{-# INLINE contextsOnOf #-}++-- | The one-level version of 'context'. This extracts a list of the immediate children as editable contexts.+--+-- Given a context you can use 'pos' to see the values, 'peek' at what the structure would be like with an edited result, or simply 'extract' the original structure.+--+-- @+-- propChildren x = 'children' l x '==' 'map' 'pos' ('holes' l x)+-- propId x = 'all' ('==' x) [extract w | w <- 'holes' l x]+-- @+--+-- @'holes' = 'holesOf' 'plate'@+holes :: Plated a => a -> [Context a a a]+holes = holesOf plate+{-# INLINE holes #-}++-- | The one-level version of 'contextsOf'. This extracts a list of the immediate children according to a given 'Traversal' as editable contexts.+--+-- Given a context you can use 'pos' to see the values, 'peek' at what the structure would be like with an edited result, or simply 'extract' the original structure.+--+-- @+-- propChildren l x = 'childrenOf' l x '==' 'map' 'pos' ('holesOf' l x)+-- propId l x = 'all' ('==' x) [extract w | w <- 'holesOf' l x]+-- @+--+-- @+-- 'holesOf' :: 'Simple' 'Iso' a b       -> a -> ['Context' b a]+-- 'holesOf' :: 'Simple' 'Lens' a b      -> a -> ['Context' b a]+-- 'holesOf' :: 'Simple' 'Traversal' a b -> a -> ['Context' b a]+-- @+holesOf :: LensLike (Bazaar c c) a b c c -> a -> [Context c c b]+holesOf l a = f (ins b) (outs b) where+  b = l sell a+  f []     _ = []+  f (x:xs) g = Context (g . (:xs)) x : f xs (g . (x:))+{-# INLINE holesOf #-}+++-- | An alias for 'holesOf', provided for consistency with the other combinators.+--+-- @'holesOn' = 'holesOf'@+--+-- @+-- 'holesOn' :: 'Simple' 'Iso' a b       -> a -> ['Context' b b a]+-- 'holesOn' :: 'Simple' 'Lens' a b      -> a -> ['Context' b b a]+-- 'holesOn' :: 'Simple' 'Traversal' a b -> a -> ['Context' b b a]+-- @+holesOn :: LensLike (Bazaar c c) a b c c -> a -> [Context c c b]+holesOn = holesOf+{-# INLINE holesOn #-}++-- | Extract one level of holes from a container in a region specified by one 'Traversal', using another.+--+-- @'holesOnOf' b l = 'holesOf' (b '.' l)@+--+-- @+-- 'holesOnOf' :: 'Simple' 'Iso' a b       -> 'Simple' 'Iso' b b       -> a -> ['Context' b a]+-- 'holesOnOf' :: 'Simple' 'Lens' a b      -> 'Simple' 'Lens' b b      -> a -> ['Context' b a]+-- 'holesOnOf' :: 'Simple' 'Traversal' a b -> 'Simple' 'Traversal' b b -> a -> ['Context' b a]+-- @+holesOnOf :: LensLike (Bazaar e e) a b c d -> LensLike (Bazaar e e) c d e e -> a -> [Context e e b]+holesOnOf b l = holesOf (b.l)+{-# INLINE holesOnOf #-}++-------------------------------------------------------------------------------+-- Paramorphisms+-------------------------------------------------------------------------------++-- | Perform a fold-like computation on each value, technically a paramorphism.+--+-- @'paraOf' :: 'Fold' a a -> (a -> [r] -> r) -> a -> r@+paraOf :: Getting [a] a a -> (a -> [r] -> r) -> a -> r+paraOf l f = go where+  go a = f a (go <$> toListOf l a)+{-# INLINE paraOf #-}++-- | Perform a fold-like computation on each value, technically a paramorphism.+--+-- @'para' = 'paraOf' 'plate'@+para :: Plated a => (a -> [r] -> r) -> a -> r+para = paraOf plate+{-# INLINE para #-}++-------------------------------------------------------------------------------+-- Compos+-------------------------------------------------------------------------------++-- $compos+--+-- Provided for compatibility with Björn Bringert's @compos@ library.+--+-- Note: Other operations from compos that were inherited by @uniplate@ are /not/ included+-- to avoid having even more redundant names for the same operators. For comparison:+--+-- @+-- 'composOpMonoid' = 'foldMapOf' 'plate'+-- 'composOpMPlus' f = 'msumOf' ('plate' '.' 'to' f)+-- 'composOp' = 'descend' = 'over' 'plate'+-- 'composOpM' = 'descendM' = 'mapMOf' 'plate'+-- 'composOpM_' = 'descendM_' = 'mapMOf_' 'plate'+-- @++-- | Fold the immediate children of a 'Plated' container.+--+-- @'composOpFold' z c f = 'foldrOf' 'plate' (c '.' f) z@+composOpFold :: Plated a => b -> (b -> b -> b) -> (a -> b) -> a -> b+composOpFold z c f = foldrOf plate (c . f) z+{-# INLINE composOpFold #-}++-------------------------------------------------------------------------------+-- Parts+-------------------------------------------------------------------------------++-- | The original @uniplate@ combinator, implemented in terms of 'Plated' as a 'Lens'.+--+-- @'parts' = 'partsOf' 'plate'@+--+-- The resulting lens is safer to use as it ignores 'over-application' and deals gracefully with under-application,+-- but it is only a proper lens if you don't change the list 'length'!+parts :: Plated a => Simple Lens a [a]+parts = partsOf plate+{-# INLINE parts #-}++-- | 'partsOf' turns a 'Traversal' into a lens that resembles an early version of the @uniplate@ (or @biplate@) type.+--+-- /Note:/ You should really, maintain the invariant of the number of children in the list.+--+-- Any extras will be lost.+--+-- If you do not supply enough, then the remainder will come from the original structure.+--+-- @+-- 'partsOf' :: 'Simple' 'Control.Lens.Iso.Iso' a b       -> a -> 'Simple' 'Lens' a [b]+-- 'partsOf' :: 'Simple' 'Lens' a b      -> a -> 'Simple' 'Lens' a [b]+-- 'partsOf' :: 'Simple' 'Traversal' a b -> a -> 'Simple' 'Traversal' a [b]+-- @+partsOf :: LensLike (Bazaar c c) a b c c -> Lens a b [c] [c]+partsOf l f a = outs b <$> f (ins b) where b = l sell a+{-# INLINE partsOf #-}++-- | 'unsafePartsOf' turns a 'Traversal' into a @uniplate@ (or @biplate@) family.+--+-- If you do not need the types of @c@ and @d@ to be different, it is recommended that+-- you use 'partsOf'+--+-- It is generally safer to traverse with the 'Bazaar' rather than use this+-- combinator. However, it is sometimes convenient.+--+-- This is unsafe because if you don't supply at least as many @d@'s as you were+-- given @c@'s, then the reconstruction of @b@ /will/ result in an error!+--+unsafePartsOf :: LensLike (Bazaar c d) a b c d -> Lens a b [c] [d]+unsafePartsOf l f a = unsafeOuts b <$> f (ins b) where b = l sell a+{-# INLINE unsafePartsOf #-}++++-------------------------------------------------------------------------------+-- Misc.+-------------------------------------------------------------------------------++ins :: Bazaar c d a -> [c]+ins (Bazaar m) = getConst (m (Const . return))+{-# INLINE ins #-}++newtype Out c a = Out { withOut :: [c] -> (a, [c]) }++instance Functor (Out c) where+  fmap f (Out m) = Out $ \cs -> case m cs of+    (as, ds) -> (f as, ds)+  {-# INLINE fmap #-}++instance Applicative (Out c) where+  pure a = Out $ \cs -> (a, cs)+  {-# INLINE pure #-}+  Out mf <*> Out ma = Out $ \cs -> case mf cs of+    (f,  ds) -> case ma ds of+       (a,  es) -> (f a, es)+  {-# INLINE (<*>) #-}++outs :: Bazaar c c a -> [c] -> a+outs (Bazaar m) = fst . withOut (m $ \c -> Out $ \cs -> case cs of+  [] -> (c, [])+  (d:ds) -> (d, ds))+{-# INLINE outs #-}++unsafeOuts :: Bazaar c d a -> [d] -> a+unsafeOuts (Bazaar m) = fst . withOut (m $ \_ -> Out $ \cs -> case cs of+  (d:ds) -> (d, ds)+  [] -> error "unsafePartsOf: not enough elements were supplied")+{-# INLINE unsafeOuts #-}
src/Control/Lens/Setter.hs view
@@ -39,11 +39,14 @@   , (.=), (%=)   , (+=), (-=), (*=), (//=), (^=), (^^=), (**=), (||=), (&&=), (<.=)   , (<~)+  -- * Storing Setters+  , ReifiedSetter(..)   -- * Setter Internals   , Setting   , SimpleSetting   -- * Simplicity   , SimpleSetter+  , SimpleReifiedSetter   ) where  import Control.Applicative@@ -182,10 +185,10 @@ -- @ -- -- @--- mapOf :: 'Setter' a b c d      -> (c -> d) -> a -> b--- mapOf :: 'Control.Lens.Iso.Iso' a b c d         -> (c -> d) -> a -> b--- mapOf :: 'Control.Lens.Type.Lens' a b c d        -> (c -> d) -> a -> b--- mapOf :: 'Control.Lens.Traversal.Traversal' a b c d   -> (c -> d) -> a -> b+-- 'mapOf' :: 'Setter' a b c d      -> (c -> d) -> a -> b+-- 'mapOf' :: 'Control.Lens.Iso.Iso' a b c d         -> (c -> d) -> a -> b+-- 'mapOf' :: 'Control.Lens.Type.Lens' a b c d        -> (c -> d) -> a -> b+-- 'mapOf' :: 'Control.Lens.Traversal.Traversal' a b c d   -> (c -> d) -> a -> b -- @ mapOf :: Setting a b c d -> (c -> d) -> a -> b mapOf = over@@ -207,10 +210,10 @@ -- relatively nice error message. -- -- @--- set :: 'Setter' a b c d    -> d -> a -> b--- set :: 'Control.Lens.Iso.Iso' a b c d       -> d -> a -> b--- set :: 'Control.Lens.Type.Lens' a b c d      -> d -> a -> b--- set :: 'Control.Lens.Traversal.Traversal' a b c d -> d -> a -> b+-- 'set' :: 'Setter' a b c d    -> d -> a -> b+-- 'set' :: 'Control.Lens.Iso.Iso' a b c d       -> d -> a -> b+-- 'set' :: 'Control.Lens.Type.Lens' a b c d      -> d -> a -> b+-- 'set' :: 'Control.Lens.Traversal.Traversal' a b c d -> d -> a -> b -- @ set :: Setting a b c d -> d -> a -> b set l d = runMutator . l (\_ -> Mutator d)@@ -231,10 +234,10 @@ -- (1,5) -- -- @--- (%~) :: 'Setter' a b c d    -> (c -> d) -> a -> b--- (%~) :: 'Control.Lens.Iso.Iso' a b c d       -> (c -> d) -> a -> b--- (%~) :: 'Control.Lens.Type.Lens' a b c d      -> (c -> d) -> a -> b--- (%~) :: 'Control.Lens.Traversal.Traversal' a b c d -> (c -> d) -> a -> b+-- ('%~') :: 'Setter' a b c d    -> (c -> d) -> a -> b+-- ('%~') :: 'Control.Lens.Iso.Iso' a b c d       -> (c -> d) -> a -> b+-- ('%~') :: 'Control.Lens.Type.Lens' a b c d      -> (c -> d) -> a -> b+-- ('%~') :: 'Control.Lens.Traversal.Traversal' a b c d -> (c -> d) -> a -> b -- @ (%~) :: Setting a b c d -> (c -> d) -> a -> b (%~) = over@@ -252,10 +255,10 @@ -- ("hello","world") -- -- @--- (.~) :: 'Setter' a b c d    -> d -> a -> b--- (.~) :: 'Control.Lens.Iso.Iso' a b c d       -> d -> a -> b--- (.~) :: 'Control.Lens.Type.Lens' a b c d      -> d -> a -> b--- (.~) :: 'Control.Lens.Traversal.Traversal' a b c d -> d -> a -> b+-- ('.~') :: 'Setter' a b c d    -> d -> a -> b+-- ('.~') :: 'Control.Lens.Iso.Iso' a b c d       -> d -> a -> b+-- ('.~') :: 'Control.Lens.Type.Lens' a b c d      -> d -> a -> b+-- ('.~') :: 'Control.Lens.Traversal.Traversal' a b c d -> d -> a -> b -- @ (.~) :: Setting a b c d -> d -> a -> b (.~) = set@@ -268,10 +271,10 @@ -- If you do not need a copy of the intermediate result, then using @l '.~' d@ directly is a good idea. -- -- @--- (\<.~) :: 'Setter' a b c d    -> d -> a -> (d, b)--- (\<.~) :: 'Control.Lens.Iso.Iso' a b c d       -> d -> a -> (d, b)--- (\<.~) :: 'Control.Lens.Type.Lens' a b c d      -> d -> a -> (d, b)--- (\<.~) :: 'Control.Lens.Traversal.Traversal' a b c d -> d -> a -> (d, b)+-- ('\<.~') :: 'Setter' a b c d    -> d -> a -> (d, b)+-- ('\<.~') :: 'Control.Lens.Iso.Iso' a b c d       -> d -> a -> (d, b)+-- ('\<.~') :: 'Control.Lens.Type.Lens' a b c d      -> d -> a -> (d, b)+-- ('\<.~') :: 'Control.Lens.Traversal.Traversal' a b c d -> d -> a -> (d, b) -- @ (<.~) :: Setting a b c d -> d -> a -> (d, b) l <.~ d = \a -> (d, l .~ d $ a)@@ -284,10 +287,10 @@ -- (2,2) -- -- @--- (+~) :: Num c => 'Setter' a b c c -> c -> a -> b--- (+~) :: Num c => 'Control.Lens.Iso.Iso' a b c c -> c -> a -> b--- (+~) :: Num c => 'Control.Lens.Type.Lens' a b c c -> c -> a -> b--- (+~) :: Num c => 'Control.Lens.Traversal.Traversal' a b c c -> c -> a -> b+-- ('+~') :: Num c => 'Setter' a b c c -> c -> a -> b+-- ('+~') :: Num c => 'Control.Lens.Iso.Iso' a b c c -> c -> a -> b+-- ('+~') :: Num c => 'Control.Lens.Type.Lens' a b c c -> c -> a -> b+-- ('+~') :: Num c => 'Control.Lens.Traversal.Traversal' a b c c -> c -> a -> b -- @ (+~) :: Num c => Setting a b c c -> c -> a -> b l +~ n = over l (+ n)@@ -300,10 +303,10 @@ -- (1,8) -- -- @--- (*~) :: 'Num' c => 'Setter' a b c c -> c -> a -> b--- (*~) :: 'Num' c => 'Control.Lens.Iso.Iso' a b c c -> c -> a -> b--- (*~) :: 'Num' c => 'Control.Lens.Type.Lens' a b c c -> c -> a -> b--- (*~) :: 'Num' c => 'Control.Lens.Traversal.Traversal' a b c c -> c -> a -> b+-- ('*~') :: 'Num' c => 'Setter' a b c c -> c -> a -> b+-- ('*~') :: 'Num' c => 'Control.Lens.Iso.Iso' a b c c -> c -> a -> b+-- ('*~') :: 'Num' c => 'Control.Lens.Type.Lens' a b c c -> c -> a -> b+-- ('*~') :: 'Num' c => 'Control.Lens.Traversal.Traversal' a b c c -> c -> a -> b -- @ (*~) :: Num c => Setting a b c c -> c -> a -> b l *~ n = over l (* n)@@ -328,10 +331,10 @@ -- | Divide the target(s) of a numerically valued 'Control.Lens.Type.Lens', 'Control.Lens.Iso.Iso', 'Setter' or 'Control.Lens.Traversal.Traversal' -- -- @--- (\/\/~) :: 'Fractional' c => 'Setter' a b c c -> c -> a -> b--- (\/\/~) :: 'Fractional' c => 'Control.Lens.Iso.Iso' a b c c -> c -> a -> b--- (\/\/~) :: 'Fractional' c => 'Control.Lens.Type.Lens' a b c c -> c -> a -> b--- (\/\/~) :: 'Fractional' c => 'Control.Lens.Traversal.Traversal' a b c c -> c -> a -> b+-- ('\/\/~') :: 'Fractional' c => 'Setter' a b c c -> c -> a -> b+-- ('\/\/~') :: 'Fractional' c => 'Control.Lens.Iso.Iso' a b c c -> c -> a -> b+-- ('\/\/~') :: 'Fractional' c => 'Control.Lens.Type.Lens' a b c c -> c -> a -> b+-- ('\/\/~') :: 'Fractional' c => 'Control.Lens.Traversal.Traversal' a b c c -> c -> a -> b -- @ (//~) :: Fractional c => Setting a b c c -> c -> a -> b l //~ n = over l (/ n)@@ -352,10 +355,10 @@ -- (1,0.5) -- -- @--- (^^~) :: ('Fractional' c, 'Integral' e) => 'Setter' a b c c -> e -> a -> b--- (^^~) :: ('Fractional' c, 'Integral' e) => 'Control.Lens.Iso.Iso' a b c c -> e -> a -> b--- (^^~) :: ('Fractional' c, 'Integral' e) => 'Control.Lens.Type.Lens' a b c c -> e -> a -> b--- (^^~) :: ('Fractional' c, 'Integral' e) => 'Control.Lens.Traversal.Traversal' a b c c -> e -> a -> b+-- ('^^~') :: ('Fractional' c, 'Integral' e) => 'Setter' a b c c -> e -> a -> b+-- ('^^~') :: ('Fractional' c, 'Integral' e) => 'Control.Lens.Iso.Iso' a b c c -> e -> a -> b+-- ('^^~') :: ('Fractional' c, 'Integral' e) => 'Control.Lens.Type.Lens' a b c c -> e -> a -> b+-- ('^^~') :: ('Fractional' c, 'Integral' e) => 'Control.Lens.Traversal.Traversal' a b c c -> e -> a -> b -- @ -- (^^~) :: (Fractional c, Integral e) => Setting a b c c -> e -> a -> b@@ -369,10 +372,10 @@ -- (1,31.54428070019754) -- -- @--- (**~) :: 'Floating' c => 'Setter' a b c c -> c -> a -> b--- (**~) :: 'Floating' c => 'Control.Lens.Iso.Iso' a b c c -> c -> a -> b--- (**~) :: 'Floating' c => 'Control.Lens.Type.Lens' a b c c -> c -> a -> b--- (**~) :: 'Floating' c => 'Control.Lens.Traversal.Traversal' a b c c -> c -> a -> b+-- ('**~') :: 'Floating' c => 'Setter' a b c c -> c -> a -> b+-- ('**~') :: 'Floating' c => 'Control.Lens.Iso.Iso' a b c c -> c -> a -> b+-- ('**~') :: 'Floating' c => 'Control.Lens.Type.Lens' a b c c -> c -> a -> b+-- ('**~') :: 'Floating' c => 'Control.Lens.Traversal.Traversal' a b c c -> c -> a -> b -- @ (**~) :: Floating c => Setting a b c c -> c -> a -> b l **~ n = over l (** n)@@ -380,7 +383,7 @@  -- | Logically '||' the target(s) of a 'Bool'-valued 'Control.Lens.Type.Lens' or 'Setter' ----- >>> :m + Control.Lens Data.Pair.Lens+-- >>> :m + Control.Lens -- -- >>> both ||~ True $ (False,True) -- (True,True)@@ -400,7 +403,7 @@  -- | Logically '&&' the target(s) of a 'Bool'-valued 'Control.Lens.Type.Lens' or 'Setter' ----- >>> :m + Control.Lens Data.Pair.Lens+-- >>> :m + Control.Lens -- -- >>> both &&~ True $ (False, True) -- (False,True)@@ -426,10 +429,10 @@ -- state with a new value, irrespective of the old. -- -- @--- (.=) :: 'MonadState' a m => 'Control.Lens.Iso.Iso' a a c d             -> d -> m ()--- (.=) :: 'MonadState' a m => 'Control.Lens.Type.Lens' a a c d            -> d -> m ()--- (.=) :: 'MonadState' a m => 'Control.Lens.Traversal.Traversal' a a c d       -> d -> m ()--- (.=) :: 'MonadState' a m => 'Setter' a a c d          -> d -> m ()+-- ('.=') :: 'MonadState' a m => 'Control.Lens.Iso.Iso' a a c d             -> d -> m ()+-- ('.=') :: 'MonadState' a m => 'Control.Lens.Type.Lens' a a c d            -> d -> m ()+-- ('.=') :: 'MonadState' a m => 'Control.Lens.Traversal.Traversal' a a c d       -> d -> m ()+-- ('.=') :: 'MonadState' a m => 'Setter' a a c d          -> d -> m () -- @ -- -- "It puts the state in the monad or it gets the hose again."@@ -440,10 +443,10 @@ -- | Map over the target of a 'Control.Lens.Type.Lens' or all of the targets of a 'Setter' or 'Control.Lens.Traversal.Traversal' in our monadic state. -- -- @--- (%=) :: 'MonadState' a m => 'Control.Lens.Iso.Iso' a a c d             -> (c -> d) -> m ()--- (%=) :: 'MonadState' a m => 'Control.Lens.Type.Lens' a a c d            -> (c -> d) -> m ()--- (%=) :: 'MonadState' a m => 'Control.Lens.Traversal.Traversal' a a c d       -> (c -> d) -> m ()--- (%=) :: 'MonadState' a m => 'Setter' a a c d          -> (c -> d) -> m ()+-- ('%=') :: 'MonadState' a m => 'Control.Lens.Iso.Iso' a a c d             -> (c -> d) -> m ()+-- ('%=') :: 'MonadState' a m => 'Control.Lens.Type.Lens' a a c d            -> (c -> d) -> m ()+-- ('%=') :: 'MonadState' a m => 'Control.Lens.Traversal.Traversal' a a c d       -> (c -> d) -> m ()+-- ('%=') :: 'MonadState' a m => 'Setter' a a c d          -> (c -> d) -> m () -- @ (%=) :: MonadState a m => Setting a a c d -> (c -> d) -> m () l %= f = State.modify (l %~ f)@@ -461,10 +464,10 @@ -- @ -- -- @--- (+=) :: ('MonadState' a m, 'Num' b) => 'Control.Lens.Type.Simple' 'Setter' a b -> b -> m ()--- (+=) :: ('MonadState' a m, 'Num' b) => 'Control.Lens.Type.Simple' 'Control.Lens.Iso.Iso' a b -> b -> m ()--- (+=) :: ('MonadState' a m, 'Num' b) => 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a b -> b -> m ()--- (+=) :: ('MonadState' a m, 'Num' b) => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a b -> b -> m ()+-- ('+=') :: ('MonadState' a m, 'Num' b) => 'Control.Lens.Type.Simple' 'Setter' a b -> b -> m ()+-- ('+=') :: ('MonadState' a m, 'Num' b) => 'Control.Lens.Type.Simple' 'Control.Lens.Iso.Iso' a b -> b -> m ()+-- ('+=') :: ('MonadState' a m, 'Num' b) => 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a b -> b -> m ()+-- ('+=') :: ('MonadState' a m, 'Num' b) => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a b -> b -> m () -- @ (+=) :: (MonadState a m, Num b) => SimpleSetting a b -> b -> m () l += b = State.modify (l +~ b)@@ -484,13 +487,13 @@  -- | Modify the target(s) of a 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens', 'Control.Lens.Iso.Iso', 'Setter' or 'Control.Lens.Traversal.Traversal' by multiplying by value. ----- @ballSpeed '.' 'Data.Pair.Lens.both' '*=' speedMultiplier@+-- @ballSpeed '.' 'Control.Lens.Traversal.both' '*=' speedMultiplier@ -- -- @--- (*=) :: ('MonadState' a m, 'Num' b) => 'Control.Lens.Type.Simple' 'Setter' a b -> b -> m ()--- (*=) :: ('MonadState' a m, 'Num' b) => 'Control.Lens.Type.Simple' 'Control.Lens.Iso.Iso' a b -> b -> m ()--- (*=) :: ('MonadState' a m, 'Num' b) => 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a b -> b -> m ()--- (*=) :: ('MonadState' a m, 'Num' b) => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a b -> b -> m ()+-- ('*=') :: ('MonadState' a m, 'Num' b) => 'Control.Lens.Type.Simple' 'Setter' a b -> b -> m ()+-- ('*=') :: ('MonadState' a m, 'Num' b) => 'Control.Lens.Type.Simple' 'Control.Lens.Iso.Iso' a b -> b -> m ()+-- ('*=') :: ('MonadState' a m, 'Num' b) => 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a b -> b -> m ()+-- ('*=') :: ('MonadState' a m, 'Num' b) => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a b -> b -> m () -- @ (*=) :: (MonadState a m, Num b) => SimpleSetting a b -> b -> m () l *= b = State.modify (l *~ b)@@ -499,10 +502,10 @@ -- | Modify the target(s) of a 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens', 'Control.Lens.Iso.Iso', 'Setter' or 'Control.Lens.Traversal.Traversal' by dividing by a value. -- -- @--- (//=) :: ('MonadState' a m, 'Fractional' b) => 'Control.Lens.Type.Simple' 'Setter' a b -> b -> m ()--- (//=) :: ('MonadState' a m, 'Fractional' b) => 'Control.Lens.Type.Simple' 'Control.Lens.Iso.Iso' a b -> b -> m ()--- (//=) :: ('MonadState' a m, 'Fractional' b) => 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a b -> b -> m ()--- (//=) :: ('MonadState' a m, 'Fractional' b) => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a b -> b -> m ()+-- ('//=') :: ('MonadState' a m, 'Fractional' b) => 'Control.Lens.Type.Simple' 'Setter' a b -> b -> m ()+-- ('//=') :: ('MonadState' a m, 'Fractional' b) => 'Control.Lens.Type.Simple' 'Control.Lens.Iso.Iso' a b -> b -> m ()+-- ('//=') :: ('MonadState' a m, 'Fractional' b) => 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a b -> b -> m ()+-- ('//=') :: ('MonadState' a m, 'Fractional' b) => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a b -> b -> m () -- @ (//=) :: (MonadState a m, Fractional b) => SimpleSetting a b -> b -> m () l //= b = State.modify (l //~ b)@@ -511,10 +514,10 @@ -- | Raise the target(s) of a numerically valued 'Control.Lens.Type.Lens', 'Setter' or 'Control.Lens.Traversal.Traversal' to a non-negative integral power. -- -- @--- (^=) ::  ('MonadState' a m, 'Fractional' b, 'Integral' c) => 'Control.Lens.Type.Simple' 'Setter' a b -> c -> m ()--- (^=) ::  ('MonadState' a m, 'Fractional' b, 'Integral' c) => 'Control.Lens.Type.Simple' 'Control.Lens.Iso.Iso' a b -> c -> m ()--- (^=) ::  ('MonadState' a m, 'Fractional' b, 'Integral' c) => 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a b -> c -> m ()--- (^=) ::  ('MonadState' a m, 'Fractional' b, 'Integral' c) => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a b -> c -> m ()+-- ('^=') ::  ('MonadState' a m, 'Fractional' b, 'Integral' c) => 'Control.Lens.Type.Simple' 'Setter' a b -> c -> m ()+-- ('^=') ::  ('MonadState' a m, 'Fractional' b, 'Integral' c) => 'Control.Lens.Type.Simple' 'Control.Lens.Iso.Iso' a b -> c -> m ()+-- ('^=') ::  ('MonadState' a m, 'Fractional' b, 'Integral' c) => 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a b -> c -> m ()+-- ('^=') ::  ('MonadState' a m, 'Fractional' b, 'Integral' c) => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a b -> c -> m () -- @ (^=) :: (MonadState a m, Fractional b, Integral c) => SimpleSetting a b -> c -> m () l ^= c = State.modify (l ^~ c)@@ -523,10 +526,10 @@ -- | Raise the target(s) of a numerically valued 'Control.Lens.Type.Lens', 'Setter' or 'Control.Lens.Traversal.Traversal' to an integral power. -- -- @--- (^^=) ::  ('MonadState' a m, 'Fractional' b, 'Integral' c) => 'Control.Lens.Type.Simple' 'Setter' a b -> c -> m ()--- (^^=) ::  ('MonadState' a m, 'Fractional' b, 'Integral' c) => 'Control.Lens.Type.Simple' 'Control.Lens.Iso.Iso' a b -> c -> m ()--- (^^=) ::  ('MonadState' a m, 'Fractional' b, 'Integral' c) => 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a b -> c -> m ()--- (^^=) ::  ('MonadState' a m, 'Fractional' b, 'Integral' c) => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a b -> c -> m ()+-- ('^^=') ::  ('MonadState' a m, 'Fractional' b, 'Integral' c) => 'Control.Lens.Type.Simple' 'Setter' a b -> c -> m ()+-- ('^^=') ::  ('MonadState' a m, 'Fractional' b, 'Integral' c) => 'Control.Lens.Type.Simple' 'Control.Lens.Iso.Iso' a b -> c -> m ()+-- ('^^=') ::  ('MonadState' a m, 'Fractional' b, 'Integral' c) => 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a b -> c -> m ()+-- ('^^=') ::  ('MonadState' a m, 'Fractional' b, 'Integral' c) => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a b -> c -> m () -- @ (^^=) :: (MonadState a m, Fractional b, Integral c) => SimpleSetting a b -> c -> m () l ^^= c = State.modify (l ^^~ c)@@ -535,10 +538,10 @@ -- | Raise the target(s) of a numerically valued 'Control.Lens.Type.Lens', 'Setter' or 'Control.Lens.Traversal.Traversal' to an arbitrary power -- -- @--- (**=) ::  ('MonadState' a m, 'Floating' b) => 'Control.Lens.Type.Simple' 'Setter' a b -> b -> m ()--- (**=) ::  ('MonadState' a m, 'Floating' b) => 'Control.Lens.Type.Simple' 'Control.Lens.Iso.Iso' a b -> b -> m ()--- (**=) ::  ('MonadState' a m, 'Floating' b) => 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a b -> b -> m ()--- (**=) ::  ('MonadState' a m, 'Floating' b) => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a b -> b -> m ()+-- ('**=') ::  ('MonadState' a m, 'Floating' b) => 'Control.Lens.Type.Simple' 'Setter' a b -> b -> m ()+-- ('**=') ::  ('MonadState' a m, 'Floating' b) => 'Control.Lens.Type.Simple' 'Control.Lens.Iso.Iso' a b -> b -> m ()+-- ('**=') ::  ('MonadState' a m, 'Floating' b) => 'Control.Lens.Type.Simple' 'Control.Lens.Type.Lens' a b -> b -> m ()+-- ('**=') ::  ('MonadState' a m, 'Floating' b) => 'Control.Lens.Type.Simple' 'Control.Lens.Traversal.Traversal' a b -> b -> m () -- @ (**=) :: (MonadState a m, Floating b) => SimpleSetting a b -> b -> m () l **= b = State.modify (l **~ b)@@ -571,10 +574,10 @@ -- | Run a monadic action, and set all of the targets of a 'Control.Lens.Type.Lens', 'Setter' or 'Control.Lens.Traversal.Traversal' to its result. -- -- @--- (\<~) :: 'MonadState' a m => 'Control.Lens.Iso.Iso' a a c d       -> m d -> m ()--- (\<~) :: 'MonadState' a m => 'Control.Lens.Type.Lens' a a c d      -> m d -> m ()--- (\<~) :: 'MonadState' a m => 'Control.Lens.Traversal.Traversal' a a c d -> m d -> m ()--- (\<~) :: 'MonadState' a m => 'Setter' a a c d    -> m d -> m ()+-- ('\<~') :: 'MonadState' a m => 'Control.Lens.Iso.Iso' a a c d       -> m d -> m ()+-- ('\<~') :: 'MonadState' a m => 'Control.Lens.Type.Lens' a a c d      -> m d -> m ()+-- ('\<~') :: 'MonadState' a m => 'Control.Lens.Traversal.Traversal' a a c d -> m d -> m ()+-- ('\<~') :: 'MonadState' a m => 'Setter' a a c d    -> m d -> m () -- @ -- -- As a reasonable mnemonic, this lets you store the result of a monadic action in a lens rather than@@ -602,13 +605,19 @@ -- If you do not need a copy of the intermediate result, then using @l .= d@ will avoid unused binding warnings -- -- @--- (\<.=) :: 'MonadState' a m => 'Setter' a a c d -> d -> m d--- (\<.=) :: 'MonadState' a m => 'Control.Lens.Iso.Iso' a a c d -> d -> m d--- (\<.=) :: 'MonadState' a m => 'Control.Lens.Type.Lens' a a c d -> d -> m d--- (\<.=) :: 'MonadState' a m => 'Control.Lens.Traversal.Traversal' a a c d -> d -> m d+-- ('\<.=') :: 'MonadState' a m => 'Setter' a a c d -> d -> m d+-- ('\<.=') :: 'MonadState' a m => 'Control.Lens.Iso.Iso' a a c d -> d -> m d+-- ('\<.=') :: 'MonadState' a m => 'Control.Lens.Type.Lens' a a c d -> d -> m d+-- ('\<.=') :: 'MonadState' a m => 'Control.Lens.Traversal.Traversal' a a c d -> d -> m d -- @ (<.=) :: MonadState a m => Setting a a c d -> d -> m d l <.= d = do   l .= d   return d {-# INLINE (<.=) #-}++-- | Reify a setter so it can be stored safely in a container.+newtype ReifiedSetter a b c d = ReifySetter { reflectSetter :: Setter a b c d }++-- | @type 'SimpleReifiedSetter' = 'Control.Lens.Type.Simple' 'ReifiedSetter'@+type SimpleReifiedSetter a b = ReifiedSetter a a b b
src/Control/Lens/TH.hs view
@@ -40,12 +40,12 @@ import Control.Lens.Tuple import Control.Lens.Traversal import Control.Lens.Type+import Control.Lens.IndexedLens import Control.Monad import Data.Char (toLower) import Data.Foldable import Data.List as List import Data.Map as Map hiding (toList,map,filter)-import Data.Map.Lens import Data.Maybe (isNothing,isJust) import Data.Monoid import Data.Set as Set hiding (toList,map,filter)@@ -220,11 +220,10 @@     let decl = SigD isoName $ quantified $ isoCon `apps`           if cfg^.simpleLenses then [aty,aty,cty,cty] else [aty,bty,cty,dty]     body <- makeBody isoName dataConName makeIsoFrom makeIsoTo-    inlining <- pragInlD isoName-#if MIN_VERSION_template_haskell(2,8,0)-      Inline FunLike AllPhases+#if (MIN_VERSION_template_haskell(2,8,0)) && defined(NEW_INLINE_PRAGMAS)+    inlining <- pragInlD isoName Inline FunLike AllPhases #else-      $ inlineSpecNoPhase True False+    inlining <- pragInlD isoName $ inlineSpecNoPhase True False #endif     return [decl, body, inlining]   accessorDecls <- case mkName <$> (maybeFieldName >>= view lensField cfg . nameBase) of@@ -234,11 +233,10 @@                    if cfg^.simpleLenses then [cty,cty,aty,aty]                                         else [cty,dty,aty,bty]       body <- makeBody lensName dataConName makeIsoTo makeIsoFrom-      inlining <- pragInlD lensName-#if MIN_VERSION_template_haskell(2,8,0)-        Inline FunLike AllPhases+#if (MIN_VERSION_template_haskell(2,8,0)) && defined(NEW_INLINE_PRAGMAS)+      inlining <- pragInlD lensName Inline FunLike AllPhases #else-        $ inlineSpecNoPhase True False+      inlining <- pragInlD lensName $ inlineSpecNoPhase True False #endif       return [decl, body, inlining]     _ -> return []@@ -264,7 +262,7 @@ conFieldDescs _ = []  commonFieldDescs :: [Con] -> [FieldDesc]-commonFieldDescs = toList . Prelude.foldr walk mempty where+commonFieldDescs = toList . Prelude.foldr walk Map.empty where   walk con m = Prelude.foldr step m (conFieldDescs con)   step d@(FieldDesc nm ty bds) m = case m^.at nm of     Just (FieldDesc _ _ bds') -> at nm .~ Just (FieldDesc nm ty (bds `Set.union` bds')) $ m@@ -294,7 +292,7 @@               f     <- newName "f"               x     <- newName "y"               names <- for fields $ \(n,_,_) -> newName (nameBase n)-              let expr = appsE +              let expr = appsE                        [ return (VarE 'fmap)                        , lamE [varP x] $ appsE $ conE conName : map varE (element i .~ x $ names)                        , varE f `appE` varE (names^.element i)@@ -337,11 +335,10 @@         ++ filter (\_ -> cfg^.createInstance)           [ instanceD (return []) (conT clsName `appT` conT tyConName)             [ funD methodName [clause [varP a] (normalB (varE a)) []]-            , pragInlD methodName-#if MIN_VERSION_template_haskell(2,8,0)-                Inline FunLike AllPhases+#if (MIN_VERSION_template_haskell(2,8,0)) && defined(NEW_INLINE_PRAGMAS)+            , pragInlD methodName Inline FunLike AllPhases #else-                $ inlineSpecNoPhase True False+            , pragInlD methodName $ inlineSpecNoPhase True False #endif             ]]   bodies <- for (toList fieldMap) $ \ (FieldDesc nm cty bds) ->@@ -368,11 +365,10 @@                     then [aty,aty,cty,cty]                     else [aty,bty,cty,dty]          body <- makeFieldLensBody lensName nm cons $ fmap (mkName . view _2) maybeLensClass-         inlining <- pragInlD lensName-#if MIN_VERSION_template_haskell(2,8,0)-           Inline FunLike AllPhases+#if (MIN_VERSION_template_haskell(2,8,0)) && defined(NEW_INLINE_PRAGMAS)+         inlining <- pragInlD lensName Inline FunLike AllPhases #else-           $ inlineSpecNoPhase True False+         inlining <- pragInlD lensName $ inlineSpecNoPhase True False #endif          return [decl, body, inlining]   return $ classDecls ++ Prelude.concat bodies@@ -464,8 +460,8 @@   $ lensField .~ (`Prelude.lookup` fields)   $ classyRules --- The orphan instance for old versions is bad, but programing without Applicative is worse. #if !(MIN_VERSION_template_haskell(2,7,0))+-- | The orphan instance for old versions is bad, but programing without 'Applicative' is worse. instance Applicative Q where   pure = return   (<*>) = ap
src/Control/Lens/Traversal.hs view
@@ -43,12 +43,18 @@    -- * Common Traversals   , Traversable(traverse)-  , traverseNothing+  , ignored+  , traverseLeft+  , traverseRight+  , both+   -- * Cloning Traversals   , cloneTraversal+  , ReifiedTraversal(..)    -- * Simple   , SimpleTraversal+  , SimpleReifiedTraversal   ) where  import Control.Applicative              as Applicative@@ -125,9 +131,9 @@ -- @ -- -- @--- forOf :: 'Control.Lens.Iso.Iso' a b c d -> a -> (c -> f d) -> f b--- forOf :: 'Lens' a b c d -> a -> (c -> f d) -> f b--- forOf :: 'Traversal' a b c d -> a -> (c -> f d) -> f b+-- 'forOf' :: 'Control.Lens.Iso.Iso' a b c d -> a -> (c -> f d) -> f b+-- 'forOf' :: 'Lens' a b c d -> a -> (c -> f d) -> f b+-- 'forOf' :: 'Traversal' a b c d -> a -> (c -> f d) -> f b -- @ forOf :: LensLike f a b c d -> a -> (c -> f d) -> f b forOf = flip@@ -158,9 +164,9 @@ -- @'mapM' = 'mapMOf' 'traverse'@ -- -- @--- 'mapMOf ::            'Control.Lens.Iso.Iso' a b c d       -> (c -> m d) -> a -> m b--- 'mapMOf ::            'Lens' a b c d      -> (c -> m d) -> a -> m b--- 'mapMOf :: 'Monad' m => 'Traversal' a b c d -> (c -> m d) -> a -> m b+-- 'mapMOf' ::            'Control.Lens.Iso.Iso' a b c d       -> (c -> m d) -> a -> m b+-- 'mapMOf' ::            'Lens' a b c d      -> (c -> m d) -> a -> m b+-- 'mapMOf' :: 'Monad' m => 'Traversal' a b c d -> (c -> m d) -> a -> m b -- @ mapMOf :: LensLike (WrappedMonad m) a b c d -> (c -> m d) -> a -> m b mapMOf l cmd = unwrapMonad . l (WrapMonad . cmd)@@ -173,9 +179,9 @@ -- @ -- -- @--- forMOf ::            'Control.Lens.Iso.Iso' a b c d       -> a -> (c -> m d) -> m b--- forMOf ::            'Lens' a b c d      -> a -> (c -> m d) -> m b--- forMOf :: 'Monad' m => 'Traversal' a b c d -> a -> (c -> m d) -> m b+-- 'forMOf' ::            'Control.Lens.Iso.Iso' a b c d       -> a -> (c -> m d) -> m b+-- 'forMOf' ::            'Lens' a b c d      -> a -> (c -> m d) -> m b+-- 'forMOf' :: 'Monad' m => 'Traversal' a b c d -> a -> (c -> m d) -> m b -- @ forMOf :: LensLike (WrappedMonad m) a b c d -> a -> (c -> m d) -> m b forMOf l a cmd = unwrapMonad (l (WrapMonad . cmd) a)@@ -184,14 +190,14 @@ -- | -- @ -- 'sequence' = 'sequenceOf' 'traverse'--- sequenceOf l = 'mapMOf' l id--- sequenceOf l = 'unwrapMonad' . l 'WrapMonad'+-- 'sequenceOf' l = 'mapMOf' l id+-- 'sequenceOf' l = 'unwrapMonad' . l 'WrapMonad' -- @ -- -- @--- sequenceOf ::            'Control.Lens.Iso.Iso' a b (m c) c       -> a -> m b--- sequenceOf ::            'Lens' a b (m c) c      -> a -> m b--- sequenceOf :: 'Monad' m => 'Traversal' a b (m c) c -> a -> m b+-- 'sequenceOf' ::            'Control.Lens.Iso.Iso' a b (m c) c       -> a -> m b+-- 'sequenceOf' ::            'Lens' a b (m c) c      -> a -> m b+-- 'sequenceOf' :: 'Monad' m => 'Traversal' a b (m c) c -> a -> m b -- @ sequenceOf :: LensLike (WrappedMonad m) a b (m c) c -> a -> m b sequenceOf l = unwrapMonad . l WrapMonad@@ -221,9 +227,9 @@ -- 'mapAccumROf' accumulates state from right to left. -- -- @--- mapAccumROf :: 'Control.Lens.Iso.Iso' a b c d       -> (s -> c -> (s, d)) -> s -> a -> (s, b)--- mapAccumROf :: 'Lens' a b c d      -> (s -> c -> (s, d)) -> s -> a -> (s, b)--- mapAccumROf :: 'Traversal' a b c d -> (s -> c -> (s, d)) -> s -> a -> (s, b)+-- 'mapAccumROf' :: 'Control.Lens.Iso.Iso' a b c d       -> (s -> c -> (s, d)) -> s -> a -> (s, b)+-- 'mapAccumROf' :: 'Lens' a b c d      -> (s -> c -> (s, d)) -> s -> a -> (s, b)+-- 'mapAccumROf' :: 'Traversal' a b c d -> (s -> c -> (s, d)) -> s -> a -> (s, b) -- @ mapAccumROf :: LensLike (Lazy.State s) a b c d -> (s -> c -> (s, d)) -> s -> a -> (s, b) mapAccumROf l f s0 a = swap (Lazy.runState (l (\c -> State.state (\s -> swap (f s c))) a) s0)@@ -236,9 +242,9 @@ -- 'mapAccumLOf' accumulates state from left to right. -- -- @--- mapAccumLOf :: 'Control.Lens.Iso.Iso' a b c d       -> (s -> c -> (s, d)) -> s -> a -> (s, b)--- mapAccumLOf :: 'Lens' a b c d      -> (s -> c -> (s, d)) -> s -> a -> (s, b)--- mapAccumLOf :: 'Traversal' a b c d -> (s -> c -> (s, d)) -> s -> a -> (s, b)+-- 'mapAccumLOf' :: 'Control.Lens.Iso.Iso' a b c d       -> (s -> c -> (s, d)) -> s -> a -> (s, b)+-- 'mapAccumLOf' :: 'Lens' a b c d      -> (s -> c -> (s, d)) -> s -> a -> (s, b)+-- 'mapAccumLOf' :: 'Traversal' a b c d -> (s -> c -> (s, d)) -> s -> a -> (s, b) -- @ mapAccumLOf :: LensLike (Backwards (Lazy.State s)) a b c d -> (s -> c -> (s, d)) -> s -> a -> (s, b) mapAccumLOf = mapAccumROf . backwards@@ -253,9 +259,9 @@ -- @'scanr1' = 'scanr1Of' 'traverse'@ -- -- @--- scanr1Of :: 'Control.Lens.Iso.Iso' a b c c       -> (c -> c -> c) -> a -> b--- scanr1Of :: 'Lens' a b c c      -> (c -> c -> c) -> a -> b--- scanr1Of :: 'Traversal' a b c c -> (c -> c -> c) -> a -> b+-- 'scanr1Of' :: 'Control.Lens.Iso.Iso' a b c c       -> (c -> c -> c) -> a -> b+-- 'scanr1Of' :: 'Lens' a b c c      -> (c -> c -> c) -> a -> b+-- 'scanr1Of' :: 'Traversal' a b c c -> (c -> c -> c) -> a -> b -- @ scanr1Of :: LensLike (Lazy.State (Maybe c)) a b c c -> (c -> c -> c) -> a -> b scanr1Of l f = snd . mapAccumROf l step Nothing where@@ -268,9 +274,9 @@ -- @'scanl1' = 'scanl1Of' 'traverse'@ -- -- @--- scanr1Of :: Iso a b c c       -> (c -> c -> c) -> a -> b--- scanr1Of :: Lens a b c c      -> (c -> c -> c) -> a -> b--- scanr1Of :: Traversal a b c c -> (c -> c -> c) -> a -> b+-- 'scanr1Of' :: Iso a b c c       -> (c -> c -> c) -> a -> b+-- 'scanr1Of' :: Lens a b c c      -> (c -> c -> c) -> a -> b+-- 'scanr1Of' :: Traversal a b c c -> (c -> c -> c) -> a -> b -- @ scanl1Of :: LensLike (Backwards (Lazy.State (Maybe c))) a b c c -> (c -> c -> c) -> a -> b scanl1Of l f = snd . mapAccumLOf l step Nothing where@@ -311,25 +317,67 @@  -- | This is the traversal that just doesn't return anything ----- @'traverseNothing' :: 'Applicative' f => (c -> f d) -> a -> f a@-traverseNothing :: Traversal a a c d-traverseNothing = const pure-{-# INLINE traverseNothing #-}+-- @'ignored' :: 'Applicative' f => (c -> f d) -> a -> f a@+--+-- @'ignored' = 'const' 'pure'@+ignored :: Traversal a a c d+ignored _ = pure+{-# INLINE ignored #-} +-- | Traverse both parts of a tuple with matching types.+both :: Traversal (a,a) (b,b) a b+both f (a,a') = (,) <$> f a <*> f a'+{-# INLINE both #-}++-- | A traversal for tweaking the left-hand value of an 'Either':+--+-- @traverseLeft :: 'Applicative' f => (a -> f b) -> 'Either' a c -> f ('Either' b c)@+traverseLeft :: Traversal (Either a c) (Either b c) a b+traverseLeft f (Left a)  = Left <$> f a+traverseLeft _ (Right c) = pure $ Right c+{-# INLINE traverseLeft #-}++-- | traverse the right-hand value of an 'Either':+--+-- @'traverseRight' = 'Data.Traversable.traverse'@+--+-- Unfortunately the instance for+-- @'Data.Traversable.Traversable' ('Either' c)@ is still missing from base,+-- so this can't just be 'Data.Traversable.traverse'+--+-- @traverseRight :: 'Applicative' f => (a -> f b) -> 'Either' c a -> f ('Either' c a)@+traverseRight :: Traversal (Either c a) (Either c b) a b+traverseRight _ (Left c) = pure $ Left c+traverseRight f (Right a) = Right <$> f a+{-# INLINE traverseRight #-}++ ------------------------------------------------------------------------------ -- Cloning Traversals ------------------------------------------------------------------------------ --- | A traversal is completely characterized by its behavior on the indexed--- 'Kleene' store comonad.+-- | A 'Traversal' is completely characterized by its behavior on a 'Bazaar'. -- -- Cloning a 'Traversal' is one way to make sure you arent given -- something weaker, such as a 'Control.Lens.Traversal.Fold' and can be -- used as a way to pass around traversals that have to be monomorphic in @f@. ----- Note: This only accepts a proper 'Traversal' (or 'Lens').+-- Note: This only accepts a proper 'Traversal' (or 'Lens'). To clone a 'Lens'+-- as such, use 'cloneLens' ----- To clone a 'Lens' as such, use 'cloneLens'-cloneTraversal :: Applicative f => ((c -> Kleene c d d) -> a -> Kleene c d b) -> (c -> f d) -> a -> f b-cloneTraversal l f = kleene f . l (More (Done id))+-- Note: It is usually better to 'ReifyTraversal' and use 'reflectTraversal'+-- than to 'cloneTraversal'. The former can execute at full speed, while the+-- latter needs to round trip through the 'Bazaar'.+cloneTraversal :: Applicative f => ((c -> Bazaar c d d) -> a -> Bazaar c d b) -> (c -> f d) -> a -> f b+cloneTraversal l f = bazaar f . l sell {-# INLINE cloneTraversal #-}++-- cloneTraversal' :: Applicative f => ((c -> Bazaar c d d) -> a -> Bazaar c d b) -> (c -> f d) -> a -> f b+-- cloneTraversal' l f a = runBazaar (l (\c -> Bazaar (\k -> k c)) a) f+-- {-# INLINE cloneTraversal' #-}++-- | A form of 'Traversal' that can be stored monomorphically in a container.+data ReifiedTraversal a b c d = ReifyTraversal { reflectTraversal :: Traversal a b c d }++-- | @type SimpleReifiedTraversal = 'Simple' 'ReifiedTraversal'@+type SimpleReifiedTraversal a b = ReifiedTraversal a a b b
src/Control/Lens/Type.hs view
@@ -78,6 +78,7 @@    -- * Cloning Lenses   , cloneLens+  , ReifiedLens(..)    -- * Simplified and In-Progress   , LensLike@@ -85,6 +86,7 @@   , SimpleLens   , SimpleLensLike   , SimpleOverloaded+  , SimpleReifiedLens   ) where  import Control.Applicative              as Applicative@@ -203,9 +205,9 @@ -- @('%%~') = 'id'@ -- -- @--- (%%~) :: 'Functor' f =>     'Control.Lens.Iso.Iso' a b c d       -> (c -> f d) -> a -> f b--- (%%~) :: 'Functor' f =>     'Lens' a b c d      -> (c -> f d) -> a -> f b--- (%%~) :: 'Applicative' f => 'Control.Lens.Traversal.Traversal' a b c d -> (c -> f d) -> a -> f b+-- ('%%~') :: 'Functor' f =>     'Control.Lens.Iso.Iso' a b c d       -> (c -> f d) -> a -> f b+-- ('%%~') :: 'Functor' f =>     'Lens' a b c d      -> (c -> f d) -> a -> f b+-- ('%%~') :: 'Applicative' f => 'Control.Lens.Traversal.Traversal' a b c d -> (c -> f d) -> a -> f b -- @ -- -- It may be beneficial to think about it as if it had these even more@@ -216,9 +218,9 @@ -- of its actions, by choosing @f = ((,) m)@ -- -- @--- (%%~) ::             'Control.Lens.Iso.Iso' a b c d       -> (c -> (e, d)) -> a -> (e, b)--- (%%~) ::             'Lens' a b c d      -> (c -> (e, d)) -> a -> (e, b)--- (%%~) :: 'Monoid' m => 'Control.Lens.Traversal.Traversal' a b c d -> (c -> (m, d)) -> a -> (m, b)+-- ('%%~') ::             'Control.Lens.Iso.Iso' a b c d       -> (c -> (e, d)) -> a -> (e, b)+-- ('%%~') ::             'Lens' a b c d      -> (c -> (e, d)) -> a -> (e, b)+-- ('%%~') :: 'Monoid' m => 'Control.Lens.Traversal.Traversal' a b c d -> (c -> (m, d)) -> a -> (m, b) -- @ (%%~) :: LensLike f a b c d -> (c -> f d) -> a -> f b (%%~) = id@@ -235,9 +237,9 @@ -- following more restricted type signatures: -- -- @--- (%%=) :: 'MonadState' a m             => 'Control.Lens.Iso.Iso' a a c d       -> (c -> (e, d) -> m e--- (%%=) :: 'MonadState' a m             => 'Lens' a a c d      -> (c -> (e, d) -> m e--- (%%=) :: ('MonadState' a m, 'Monoid' e) => 'Control.Lens.Traversal.Traversal' a a c d -> (c -> (e, d) -> m e+-- ('%%=') :: 'MonadState' a m             => 'Control.Lens.Iso.Iso' a a c d       -> (c -> (e, d) -> m e+-- ('%%=') :: 'MonadState' a m             => 'Lens' a a c d      -> (c -> (e, d) -> m e+-- ('%%=') :: ('MonadState' a m, 'Monoid' e) => 'Control.Lens.Traversal.Traversal' a a c d -> (c -> (e, d) -> m e -- @ (%%=) :: MonadState a m => LensLike ((,) e) a a c d -> (c -> (e, d)) -> m e #if MIN_VERSION_mtl(2,1,1)@@ -276,9 +278,9 @@ alongside :: Lens a b c d            -> Lens a' b' c' d'            -> Lens (a,a') (b,b') (c,c') (d,d')-alongside l r f (a, a') = case l (IndexedStore id) a of-  IndexedStore db c -> case r (IndexedStore id) a' of-    IndexedStore db' c' -> (\(d,d') -> (db d, db' d')) <$> f (c,c')+alongside l r f (a, a') = case l (Context id) a of+  Context db c -> case r (Context id) a' of+    Context db' c' -> (\(d,d') -> (db d, db' d')) <$> f (c,c') {-# INLINE alongside #-}  -------------------------------------------------------------------------------@@ -295,10 +297,10 @@ -- \"Costate Comonad Coalgebra is equivalent of Java's member variable -- update technology for Haskell\" -- \@PLT_Borat on Twitter cloneLens :: Functor f-      => LensLike (IndexedStore c d) a b c d-      -> (c -> f d) -> a -> f b-cloneLens f cfd a = case f (IndexedStore id) a of-  IndexedStore db c -> db <$> cfd c+  => LensLike (Context c d) a b c d+  -> (c -> f d) -> a -> f b+cloneLens f cfd a = case f (Context id) a of+  Context db c -> db <$> cfd c {-# INLINE cloneLens #-}  -------------------------------------------------------------------------------@@ -476,3 +478,8 @@ l <&&= b = l <%= (&& b) {-# INLINE (<&&=) #-} +-- | Useful for storing lenses in containers.+newtype ReifiedLens a b c d = ReifyLens { reflectLens :: Lens a b c d }++-- | @type 'SimpleReifiedLens' = 'Simple' 'ReifiedLens'@+type SimpleReifiedLens a b = ReifiedLens a a b b
+ src/Control/Lens/WithIndex.hs view
@@ -0,0 +1,416 @@+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}+-------------------------------------------------------------------------------+-- |+-- Module      :  Control.Lens.WithIndex+-- Copyright   :  (C) 2012 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  Rank2Types+--+-- (These need to be defined together for @DefaultSignatures@ to work.)+-------------------------------------------------------------------------------+module Control.Lens.WithIndex+  (+  -- * Indexed Functors+    FunctorWithIndex(..)+  , imapped+  -- * Indexed Foldables+  , FoldableWithIndex(..)+  , ifolded+  , ifolding+  -- ** Indexed Foldable Combinators+  , iany+  , iall+  , itraverse_+  , ifor_+  , imapM_+  , iforM_+  , iconcatMap+  , ifind+  , ifoldrM+  , ifoldlM+  , itoList+  -- * Indexed Traversables+  , TraversableWithIndex(..)+  , itraversed+  -- * Indexed Traversable Combinators+  , ifor+  , imapM+  , iforM+  , imapAccumR+  , imapAccumL+  ) where++import Control.Applicative+import Control.Applicative.Backwards+import Control.Monad (void, liftM)+import Control.Monad.Trans.State.Lazy as Lazy+import Control.Lens.Internal+import Control.Lens.Indexed+import Control.Lens.IndexedSetter+import Control.Lens.IndexedFold+import Control.Lens.IndexedTraversal+import Data.Foldable+import Data.Hashable+import Data.HashMap.Lazy as HashMap+import Data.IntMap as IntMap+import Data.Map as Map+import Data.Monoid+import Data.Sequence hiding (index)+import Data.Traversable++-------------------------------------------------------------------------------+-- FunctorWithIndex+-------------------------------------------------------------------------------++-- | A 'Functor' with an additional index.+--+-- Instances must satisfy a modified form of the 'Functor' laws:+--+-- @+-- 'imap' f . 'imap' g = 'imap' (\i -> f i . g i)+-- 'imap' (\_ a -> a) = 'id'+-- @+class Functor f => FunctorWithIndex i f | f -> i where+  -- | Map with access to the index.+  imap :: (i -> a -> b) -> f a -> f b+  default imap :: TraversableWithIndex i f => (i -> a -> b) -> f a -> f b+  imap = imapOf itraversed++-- | The 'IndexedSetter' for a 'FunctorWithIndex'.+--+-- If you don't need access to the index, then 'mapped' is more flexible in what it accepts.+imapped :: FunctorWithIndex i f => IndexedSetter i (f a) (f b) a b+imapped = isets imap+{-# INLINE imapped #-}++-------------------------------------------------------------------------------+-- FoldableWithIndex+-------------------------------------------------------------------------------++-- | A container that supports folding with an additional index.+class Foldable f => FoldableWithIndex i f | f -> i where+  --+  -- |+  -- Fold a container by mapping value to an arbitrary 'Monoid' with access to the index @i@.+  --+  -- When you don't need access to the index then 'foldMap' is more flexible in what it accepts.+  --+  -- @'foldMap' = 'ifoldMap' . 'const'@+  ifoldMap :: Monoid m => (i -> a -> m) -> f a -> m+  default ifoldMap :: (TraversableWithIndex i f, Monoid m) => (i -> a -> m) -> f a -> m+  ifoldMap = ifoldMapOf itraversed++  -- | Right-associative fold of an indexed container with access to the index @i@.+  --+  -- When you don't need access to the index then 'Data.Foldable.foldr' is more flexible in what it accepts.+  --+  -- @'Data.Foldable.foldr' = 'ifoldr' . 'const'@+  ifoldr   :: (i -> a -> b -> b) -> b -> f a -> b+  ifoldr f z t = appEndo (ifoldMap (\i -> Endo . f i) t) z++  -- |+  -- Left-associative fold of an indexed container with access to the index @i@.+  --+  -- When you don't need access to the index then 'foldl' is more flexible in what it accepts.+  --+  -- @'foldl' = 'ifoldl' . 'const'@+  ifoldl :: (i -> b -> a -> b) -> b -> f a -> b+  ifoldl f z t = appEndo (getDual (ifoldMap (\i -> Dual . Endo . flip (f i)) t)) z++  -- | /Strictly/ fold right over the elements of a structure with access to the index @i@.+  --+  -- When you don't need access to the index then 'foldr'' is more flexible in what it accepts.+  --+  -- @'foldr'' = 'ifoldr'' . 'const'@+  ifoldr' :: (i -> a -> b -> b) -> b -> f a -> b+  ifoldr' f z0 xs = ifoldl f' id xs z0+    where f' i k x z = k $! f i x z++  -- | Fold over the elements of a structure with an index, associating to the left, but /strictly/.+  --+  -- When you don't need access to the index then 'Control.Lens.Fold.foldlOf'' is more flexible in what it accepts.+  --+  -- @'Control.Lens.Fold.foldlOf'' l = 'ifoldlOf'' l . 'const'@+  --+  -- @+  -- 'ifoldlOf'' :: 'Control.Lens.IndexedGetter.IndexedGetter' i a c            -> (i -> e -> c -> e) -> e -> a -> e+  -- 'ifoldlOf'' :: 'IndexedFold' i a c              -> (i -> e -> c -> e) -> e -> a -> e+  -- 'ifoldlOf'' :: 'Control.Lens.IndexedLens.SimpleIndexedLens' i a c        -> (i -> e -> c -> e) -> e -> a -> e+  -- 'ifoldlOf'' :: 'Control.Lens.IndexedTraversal.SimpleIndexedTraversal' i a c   -> (i -> e -> c -> e) -> e -> a -> e+  -- @+  ifoldl' :: (i -> b -> a -> b) -> b -> f a -> b+  ifoldl' f z0 xs = ifoldr f' id xs z0+    where f' i x k z = k $! f i z x++-- | The 'IndexedFold' of a 'FoldableWithIndex' container.+ifolded :: FoldableWithIndex i f => IndexedFold i (f a) a+ifolded = index $ \ f -> coerce . getGA . ifoldMap (\i -> GA . f i)+{-# INLINE ifolded #-}++-- | Obtain a 'Fold' by lifting an operation that returns a foldable result.+--+-- This can be useful to lift operations from @Data.List@ and elsewhere into a 'Fold'.+ifolding :: FoldableWithIndex i f => (a -> f c) -> IndexedFold i a c+ifolding afc = index $ \ icgd -> coerce . itraverse_ icgd . afc+{-# INLINE ifolding #-}++-- |+-- Return whether or not any element in a container satisfies a predicate, with access to the index @i@.+--+-- When you don't need access to the index then 'any' is more flexible in what it accepts.+--+-- @'any' = 'iany' . 'const'@+--+iany :: FoldableWithIndex i f => (i -> a -> Bool) -> f a -> Bool+iany f = getAny . ifoldMap (\i -> Any . f i)+{-# INLINE iany #-}++-- |+-- Return whether or not all elements in a container satisfy a predicate, with access to the index @i@.+--+-- When you don't need access to the index then 'all' is more flexible in what it accepts.+--+-- @'all' = 'iall' . 'const'@+iall :: FoldableWithIndex i f => (i -> a -> Bool) -> f a -> Bool+iall f = getAll . ifoldMap (\i -> All . f i)+{-# INLINE iall #-}++-- |+-- Traverse elements with access to the index @i@, discarding the results.+--+-- When you don't need access to the index then 'traverse_' is more flexible in what it accepts.+--+-- @'traverse_' l = 'itraverse' . 'const'@+itraverse_ :: (FoldableWithIndex i t, Applicative f) => (i -> a -> f b) -> t a -> f ()+itraverse_ f = getTraversed . ifoldMap (\i -> Traversed . void . f i)+{-# INLINE itraverse_ #-}++-- |+-- Traverse elements with access to the index @i@, discarding the results (with the arguments flipped).+--+-- @'ifor_' = 'flip' 'itraverse_'@+--+-- When you don't need access to the index then 'for_' is more flexible in what it accepts.+--+-- @'for_' a = 'ifor_' a . 'const'@+ifor_ :: (FoldableWithIndex i t, Applicative f) => t a -> (i -> a -> f b) -> f ()+ifor_ = flip itraverse_+{-# INLINE ifor_ #-}++-- |+-- Run monadic actions for each target of an 'IndexedFold' or 'Control.Lens.IndexedTraversal.IndexedTraversal' with access to the index,+-- discarding the results.+--+-- When you don't need access to the index then 'Control.Lens.Fold.mapMOf_' is more flexible in what it accepts.+--+-- @'mapM_' = 'imapM' . 'const'@+imapM_ :: (FoldableWithIndex i t, Monad m) => (i -> a -> m b) -> t a -> m ()+imapM_ f = getSequenced . ifoldMap (\i -> Sequenced . liftM skip . f i)+{-# INLINE imapM_ #-}++-- |+-- Run monadic actions for each target of an 'IndexedFold' or 'Control.Lens.IndexedTraversal.IndexedTraversal' with access to the index,+-- discarding the results (with the arguments flipped).+--+-- @'iforM_' = 'flip' 'imapM_'@+--+-- When you don't need access to the index then 'Control.Lens.Fold.forMOf_' is more flexible in what it accepts.+--+-- @'Control.Lens.Fold.forMOf_' l a = 'iforMOf' l a . 'const'@+iforM_ :: (FoldableWithIndex i t, Monad m) => t a -> (i -> a -> m b) -> m ()+iforM_ = flip imapM_+{-# INLINE iforM_ #-}++-- |+-- Concatenate the results of a function of the elements of an indexed container with access to the index.+--+-- When you don't need access to the index then 'concatMap' is more flexible in what it accepts.+--+-- @+-- 'concatMap' = 'iconcatMap' . 'const'+-- 'iconcatMap' = 'ifoldMap'+-- @+iconcatMap :: FoldableWithIndex i f => (i -> a -> [b]) -> f a -> [b]+iconcatMap = ifoldMap+{-# INLINE iconcatMap #-}++-- | Searches a container with a predicate that is also supplied the index, returning the left-most element of the structure+-- matching the predicate, or 'Nothing' if there is no such element.+--+-- When you don't need access to the index then 'find' is more flexible in what it accepts.+--+-- @'find' = 'ifind' . 'const'@+ifind :: FoldableWithIndex i f => (i -> a -> Bool) -> f a -> Maybe (i, a)+ifind p = getFirst . ifoldMap step where+  step i c+    | p i c     = First $ Just (i, c)+    | otherwise = First Nothing+{-# INLINE ifind #-}++-- | Monadic fold right over the elements of a structure with an index.+--+-- When you don't need access to the index then 'foldrM' is more flexible in what it accepts.+--+-- @'foldrM' = 'ifoldrM' . 'const'@+ifoldrM :: (FoldableWithIndex i f, Monad m) => (i -> a -> b -> m b) -> b -> f a -> m b+ifoldrM f z0 xs = ifoldl f' return xs z0+  where f' i k x z = f i x z >>= k+{-# INLINE ifoldrM #-}++-- | Monadic fold over the elements of a structure with an index, associating to the left.+--+-- When you don't need access to the index then 'foldlM' is more flexible in what it accepts.+--+-- @'foldlM' = 'ifoldlM' . 'const'@+ifoldlM :: (FoldableWithIndex i f, Monad m) => (i -> b -> a -> m b) -> b -> f a -> m b+ifoldlM f z0 xs = ifoldr f' return xs z0+  where f' i x k z = f i z x >>= k+{-# INLINE ifoldlM #-}++-- | Extract the key-value pairs from a structure.+--+-- When you don't need access to the indices in the result, then 'toList' is more flexible in what it accepts.+--+-- @'toList' = 'map' 'fst' . 'itoList'@+itoList :: FoldableWithIndex i f => f a -> [(i,a)]+itoList = ifoldMap (\i c -> [(i,c)])+{-# INLINE itoList #-}++-------------------------------------------------------------------------------+-- TraversableWithIndex+-------------------------------------------------------------------------------++-- | A 'Traversable' with an additional index.+--+-- An instance must satisfy a (modified) form of the 'Traversable' laws:+--+-- @+-- 'itraverse' ('const' 'Data.Functor.Identity.Identity') = 'Data.Functor.Identity.Identity'+-- 'fmap' ('itraverse' f) '.' 'itraverse' g = 'getCompose' '.' 'itraverse' (\i -> 'Compose' '.' 'fmap' (f i) '.' g i)+-- @+class (FunctorWithIndex i t, FoldableWithIndex i t, Traversable t) => TraversableWithIndex i t | t -> i where+  -- | Traverse an indexed container.+  itraverse :: Applicative f => (i -> a -> f b) -> t a -> f (t b)+  default itraverse :: Applicative f => (Int -> a -> f b) -> t a -> f (t b)+  itraverse = withIndex (indexed traverse)+  {-# INLINE itraverse #-}++-- | The 'IndexedTraversal' of a 'TraversableWithIndex' container.+itraversed :: TraversableWithIndex i f => IndexedTraversal i (f a) (f b) a b+itraversed = index itraverse+{-# INLINE itraversed #-}++-- |+-- Traverse with an index (and the arguments flipped)+--+-- @+-- 'for' a = 'ifor' a . 'const'+-- 'ifor' = 'flip' 'itraverse'+-- @+ifor :: (TraversableWithIndex i t, Applicative f) => t a -> (i -> a -> f b) -> f (t b)+ifor = flip itraverse+{-# INLINE ifor #-}++-- | Map each element of a structure to a monadic action,+-- evaluate these actions from left to right, and collect the results, with access+-- the index.+--+-- When you don't need access to the index 'mapM' is more liberal in what it can accept.+--+-- @'mapM' = 'imapM' . 'const'@+imapM :: (TraversableWithIndex i t, Monad m) => (i -> a -> m b) -> t a -> m (t b)+imapM f = unwrapMonad . itraverse (\i -> WrapMonad . f i)+{-# INLINE imapM #-}++-- | Map each element of a structure to a monadic action,+-- evaluate these actions from left to right, and collect the results, with access+-- its position (and the arguments flipped).+--+-- @+-- 'forM' a = 'iforM' a . 'const'+-- 'iforM' = 'flip' 'imapM'+-- @+iforM :: (TraversableWithIndex i t, Monad m) => t a -> (i -> a -> m b) -> m (t b)+iforM = flip imapM+{-# INLINE iforM #-}++-- | Generalizes 'Data.Traversable.mapAccumR' to add access to the index.+--+-- 'imapAccumROf' accumulates state from right to left.+--+-- @'Control.Lens.Traversal.mapAccumR' = 'imapAccumR' . 'const'@+imapAccumR :: TraversableWithIndex i t => (i -> s -> a -> (s, b)) -> s -> t a -> (s, t b)+imapAccumR f s0 a = swap (Lazy.runState (itraverse (\i c -> Lazy.state (\s -> swap (f i s c))) a) s0)+{-# INLINE imapAccumR #-}++-- | Generalizes 'Data.Traversable.mapAccumL' to add access to the index.+--+-- 'imapAccumLOf' accumulates state from left to right.+--+-- @'Control.Lens.Traversal.mapAccumLOf' = 'imapAccumL' . 'const'@+imapAccumL :: TraversableWithIndex i t => (i -> s -> a -> (s, b)) -> s -> t a -> (s, t b)+imapAccumL f s0 a = swap (Lazy.runState (forwards (itraverse (\i c -> Backwards (Lazy.state (\s -> swap (f i s c)))) a)) s0)+{-# INLINE imapAccumL #-}++-------------------------------------------------------------------------------+-- Instances+-------------------------------------------------------------------------------++-- | The position in the list is available as the index.+instance FunctorWithIndex Int []+instance FoldableWithIndex Int []+instance TraversableWithIndex Int []++-- | The position in the sequence is available as the index.+instance FunctorWithIndex Int Seq+instance FoldableWithIndex Int Seq+instance TraversableWithIndex Int Seq++instance FunctorWithIndex Int IntMap+instance FoldableWithIndex Int IntMap+instance TraversableWithIndex Int IntMap where+  itraverse f = sequenceA . IntMap.mapWithKey f+  {-# INLINE itraverse #-}++instance Ord k => FunctorWithIndex k (Map k)+instance Ord k => FoldableWithIndex k (Map k)+instance Ord k => TraversableWithIndex k (Map k) where+  itraverse f = sequenceA . Map.mapWithKey f+  {-# INLINE itraverse #-}++instance (Eq k, Hashable k) => FunctorWithIndex k (HashMap k)+instance (Eq k, Hashable k) => FoldableWithIndex k (HashMap k)+instance (Eq k, Hashable k) => TraversableWithIndex k (HashMap k) where+  itraverse = HashMap.traverseWithKey+  {-# INLINE itraverse #-}++-------------------------------------------------------------------------------+-- Misc.+-------------------------------------------------------------------------------++swap :: (a,b) -> (b,a)+swap (a,b) = (b,a)+{-# INLINE swap #-}++skip :: a -> ()+skip _ = ()+{-# INLINE skip #-}++-- | A monoid in a monad as a monoid+newtype GA f a = GA { getGA :: f a }++instance (Gettable f, Applicative f) => Monoid (GA f a) where+  mempty = GA noEffect+  {-# INLINE mempty #-}+  GA fr `mappend` GA fs = GA (fr *> fs)+  {-# INLINE mappend #-}++noEffect :: (Applicative f, Gettable f) => f a+noEffect = coerce $ pure ()+{-# INLINE noEffect #-}
src/Control/Lens/Zoom.hs view
@@ -56,12 +56,12 @@   -- This can be used to edit pretty much any monad transformer stack with a state in it!   --   -- @-  -- zoom :: 'Monad' m             => 'Simple' 'Lens' a b      -> 'StateT' b m c -> 'StateT' a m c-  -- zoom :: ('Monad' m, 'Monoid' c) => 'Simple' 'Control.Lens.Traversal.Traversal' a b -> 'StateT' b m c -> 'StateT' a m c-  -- zoom :: 'Monad' m             => 'Simple' 'Lens' a b      -> 'RWST' r w b m c -> 'RWST' r w a m c-  -- zoom :: ('Monad' m, 'Monoid' c) => 'Simple' 'Control.Lens.Traversal.Traversal' a b -> 'RWST' r w b m c -> 'RWST' r w a m c-  -- zoom :: 'Monad' m             => 'Simple' 'Lens' a b      -> 'ErrorT' e ('RWST' r w b m c) -> 'ErrorT' e ('RWST' r w a m c)-  -- zoom :: ('Monad' m, 'Monoid' c) => 'Simple' 'Control.Lens.Traversal.Traversal' a b -> 'ErrorT' e ('RWST' r w b m c) -> 'ErrorT' e ('RWST' r w a m c)+  -- 'zoom' :: 'Monad' m             => 'Simple' 'Lens' a b      -> 'StateT' b m c -> 'StateT' a m c+  -- 'zoom' :: ('Monad' m, 'Monoid' c) => 'Simple' 'Control.Lens.Traversal.Traversal' a b -> 'StateT' b m c -> 'StateT' a m c+  -- 'zoom' :: 'Monad' m             => 'Simple' 'Lens' a b      -> 'RWST' r w b m c -> 'RWST' r w a m c+  -- 'zoom' :: ('Monad' m, 'Monoid' c) => 'Simple' 'Control.Lens.Traversal.Traversal' a b -> 'RWST' r w b m c -> 'RWST' r w a m c+  -- 'zoom' :: 'Monad' m             => 'Simple' 'Lens' a b      -> 'ErrorT' e ('RWST' r w b m c) -> 'ErrorT' e ('RWST' r w a m c)+  -- 'zoom' :: ('Monad' m, 'Monoid' c) => 'Simple' 'Control.Lens.Traversal.Traversal' a b -> 'ErrorT' e ('RWST' r w b m c) -> 'ErrorT' e ('RWST' r w a m c)   -- ...   -- @   zoom :: Monad m => SimpleLensLike (k c) t s -> m c -> n c@@ -127,10 +127,10 @@   -- This can be used to edit pretty much any monad transformer stack with an environment in it:   --   -- @-  -- magnify ::             'Getter' a b -> (b -> c) -> a -> c-  -- magnify :: 'Monoid' c => 'Fold' a b   -> (b -> c) -> a -> c-  -- magnify :: 'Monoid' w                'Getter' a b -> 'RWST' a w s c -> 'RWST' b w s c-  -- magnify :: ('Monoid' w, 'Monoid' c) => 'Fold' a b   -> 'RWST' a w s c -> 'RWST' b w s c+  -- 'magnify' ::             'Getter' a b -> (b -> c) -> a -> c+  -- 'magnify' :: 'Monoid' c => 'Fold' a b   -> (b -> c) -> a -> c+  -- 'magnify' :: 'Monoid' w                'Getter' a b -> 'RWST' a w s c -> 'RWST' b w s c+  -- 'magnify' :: ('Monoid' w, 'Monoid' c) => 'Fold' a b   -> 'RWST' a w s c -> 'RWST' b w s c   -- ...   -- @   magnify :: ((b -> k c b) -> a -> k c a) -> m c -> n c
src/Data/ByteString/Lens.hs view
@@ -10,56 +10,72 @@ -- ---------------------------------------------------------------------------- module Data.ByteString.Lens-  ( packedBytes, bytes-  , packedChars, chars+  ( IsByteString(..)   ) where -import Control.Lens-import Data.ByteString as Words-import Data.ByteString.Char8 as Char8-import Data.List.Lens-import Data.Word (Word8)+import           Control.Lens+import           Data.Word (Word8)+import           Data.ByteString as Strict+import qualified Data.ByteString.Strict.Lens as Strict+import           Data.ByteString.Lazy as Lazy+import qualified Data.ByteString.Lazy.Lens as Lazy --- | 'Data.ByteString.pack' (or 'Data.ByteString.unpack') a list of bytes into a 'ByteString'------ @'Data.ByteString.pack' x = x '^.' 'packedBytes'@------ @'Data.ByteString.unpack' x = x '^.' 'from' 'packedBytes'@-packedBytes :: Simple Iso [Word8] ByteString-packedBytes = iso Words.pack Words.unpack-{-# INLINE packedBytes #-}-{-# SPECIALIZE packedBytes :: Simple Lens [Word8] ByteString #-}+-- | Traversals for ByteStrings.+class IsByteString t where+  -- | 'Data.ByteString.pack' (or 'Data.ByteString.unpack') a list of bytes into a strict or lazy 'ByteString'+  --+  -- @'Data.ByteString.pack' x = x '^.' 'packedBytes'@+  --+  -- @'Data.ByteString.unpack' x = x '^.' 'from' 'packedBytes'@+  packedBytes :: Simple Iso [Word8] t --- | Traverse each 'Word8' in a 'ByteString'------ @'bytes' = 'from' 'packedBytes' '.>' 'traverseList'@------ @'anyOf' 'bytes' ('==' 0x80) :: 'ByteString' -> 'Bool'@-bytes :: SimpleIndexedTraversal Int ByteString Word8-bytes = from packedBytes .> traverseList-{-# INLINE bytes #-}+  -- | 'Data.ByteString.Char8.pack' (or 'Data.ByteString.Char8.unpack') a list of characters into a strict or lazy 'ByteString'+  --+  -- When writing back to the 'ByteString' it is assumed that every 'Char'+  -- lies between '\x00' and '\xff'.+  --+  -- @'Data.ByteString.Char8.pack' x = x '^.' 'packedChars'@+  --+  -- @'Data.ByteString.Char8.unpack' x = x '^.' 'from' 'packedChars'@+  packedChars :: Simple Iso String t --- | 'Data.ByteString.Char8.pack' (or 'Data.ByteString.Char8.unpack') a list of characters into a 'ByteString'------ When writing back to the 'ByteString' it is assumed that every 'Char'--- lies between '\x00' and '\xff'.------ @'Data.ByteString.Char8.pack' x = x '^.' 'packedChars'@------ @'Data.ByteString.Char8.unpack' x = x '^.' 'from' 'packedChars'@-packedChars :: Simple Iso String ByteString-packedChars = iso Char8.pack Char8.unpack-{-# INLINE packedChars #-}-{-# SPECIALIZE packedChars :: Simple Lens String ByteString #-}+  -- | Traverse each 'Word8' in a strict or lazy 'ByteString'+  --+  -- @'bytes' = 'from' 'packedBytes' '.>' 'traverseList'@+  --+  -- @'anyOf' 'bytes' ('==' 0x80) :: 'ByteString' -> 'Bool'@+  bytes :: SimpleIndexedTraversal Int t Word8+  bytes = from packedBytes .> itraversed+  {-# INLINE bytes #-} --- | Traverse the individual bytes in a 'ByteString' as characters.------ When writing back to the 'ByteString' it is assumed that every 'Char'--- lies between '\x00' and '\xff'.------ @'chars' = 'from' 'packed' . 'traverse'@------ @'anyOf' 'chars' ('==' \'c\') :: 'ByteString' -> 'Bool'@-chars :: SimpleIndexedTraversal Int ByteString Char-chars = from packedChars .> traverseList-{-# INLINE chars #-}+  -- | Traverse the individual bytes in a strict or lazy 'ByteString' as characters.+  --+  -- When writing back to the 'ByteString' it is assumed that every 'Char'+  -- lies between '\x00' and '\xff'.+  --+  -- @'chars' = 'from' 'packedChars' . 'traverse'@+  --+  -- @'anyOf' 'chars' ('==' \'c\') :: 'ByteString' -> 'Bool'@+  chars :: SimpleIndexedTraversal Int t Char+  chars = from packedChars .> itraversed+  {-# INLINE chars #-}++instance IsByteString Strict.ByteString where+  packedBytes = Strict.packedBytes+  {-# INLINE packedBytes #-}+  packedChars = Strict.packedChars+  {-# INLINE packedChars #-}+  bytes = Strict.bytes+  {-# INLINE bytes #-}+  chars = Strict.chars+  {-# INLINE chars #-}++instance IsByteString Lazy.ByteString where+  packedBytes = Lazy.packedBytes+  {-# INLINE packedBytes #-}+  packedChars = Lazy.packedChars+  {-# INLINE packedChars #-}+  bytes = Lazy.bytes+  {-# INLINE bytes #-}+  chars = Lazy.chars+  {-# INLINE chars #-}
+ src/Data/ByteString/Strict/Lens.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE FlexibleContexts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.ByteString.Strict.Lens+-- Copyright   :  (C) 2012 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+----------------------------------------------------------------------------+module Data.ByteString.Strict.Lens+  ( packedBytes, bytes+  , packedChars, chars+  ) where++import Control.Lens+import Data.ByteString as Words+import Data.ByteString.Char8 as Char8+import Data.List.Lens+import Data.Word (Word8)++-- | 'Data.ByteString.pack' (or 'Data.ByteString.unpack') a list of bytes into a 'ByteString'+--+-- @'Data.ByteString.pack' x = x '^.' 'packedBytes'@+--+-- @'Data.ByteString.unpack' x = x '^.' 'from' 'packedBytes'@+packedBytes :: Simple Iso [Word8] ByteString+packedBytes = iso Words.pack Words.unpack+{-# INLINE packedBytes #-}+{-# SPECIALIZE packedBytes :: Simple Lens [Word8] ByteString #-}++-- | Traverse each 'Word8' in a 'ByteString'+--+-- @'bytes' = 'from' 'packedBytes' '.>' 'traverseList'@+--+-- @'anyOf' 'bytes' ('==' 0x80) :: 'ByteString' -> 'Bool'@+bytes :: SimpleIndexedTraversal Int ByteString Word8+bytes = from packedBytes .> traverseList+{-# INLINE bytes #-}++-- | 'Data.ByteString.Char8.pack' (or 'Data.ByteString.Char8.unpack') a list of characters into a 'ByteString'+--+-- When writing back to the 'ByteString' it is assumed that every 'Char'+-- lies between '\x00' and '\xff'.+--+-- @'Data.ByteString.Char8.pack' x = x '^.' 'packedChars'@+--+-- @'Data.ByteString.Char8.unpack' x = x '^.' 'from' 'packedChars'@+packedChars :: Simple Iso String ByteString+packedChars = iso Char8.pack Char8.unpack+{-# INLINE packedChars #-}+{-# SPECIALIZE packedChars :: Simple Lens String ByteString #-}++-- | Traverse the individual bytes in a 'ByteString' as characters.+--+-- When writing back to the 'ByteString' it is assumed that every 'Char'+-- lies between '\x00' and '\xff'.+--+-- @'chars' = 'from' 'packedChars' . 'traverse'@+--+-- @'anyOf' 'chars' ('==' \'c\') :: 'ByteString' -> 'Bool'@+chars :: SimpleIndexedTraversal Int ByteString Char+chars = from packedChars .> traverseList+{-# INLINE chars #-}
+ src/Data/Data/Lens.hs view
@@ -0,0 +1,288 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE PatternGuards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ExistentialQuantification #-}+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 704+{-# LANGUAGE Trustworthy #-}+#endif+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Data.Lens+-- Copyright   :  (C) 2012 Edward Kmett, (C) 2006-2012 Neil Mitchell+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  Rank2Types+--+-- Smart and naïve generic traversals given 'Data' instances.+--+-- 'template', 'uniplate', and 'biplate' each build up information about what+-- types can be contained within another type to speed up 'Traversal'.+--+----------------------------------------------------------------------------+module Data.Data.Lens+  ( template+  , tinplate+  , uniplate+  , biplate+  -- * Traversal of Data+  , gtraverse+  ) where++import           Control.Applicative+import           Control.Arrow ((&&&))+import           Control.Exception as E+import           Control.Lens+import           Data.Data+import           Data.Foldable+import qualified Data.HashMap.Strict as M+import           Data.HashMap.Strict (HashMap, (!))+import qualified Data.HashSet as S+import           Data.HashSet (HashSet)+import           Data.IORef+import           Data.Monoid+import           GHC.IO+import           GHC.Exts (realWorld#)+import           Unsafe.Coerce as Unsafe++-------------------------------------------------------------------------------+-- Generic Traversal+-------------------------------------------------------------------------------++-- | A generic applicative transformation that maps over the immediate subterms.+--+-- 'gtraverse' is to 'traverse' what 'gmapM' is to 'mapM'+--+-- This really belongs in @Data.Data@.+gtraverse :: (Applicative f, Data a) => (forall d. Data d => d -> f d) -> a -> f a+gtraverse f = gfoldl (\x y -> x <*> f y) pure++-------------------------------------------------------------------------------+-- Naïve Traversal+-------------------------------------------------------------------------------++-- | Naïve 'Traversal' using 'Data'. This does not attempt to optimize the traversal.+--+-- This is primarily useful when the children are immediately obvious, and for benchmarking.+--+-- @+-- 'tinplate' :: ('Data' a, 'Typeable' b) => 'Simple' 'Traversal' a b+-- @+tinplate :: (Data a, Typeable b) => Simple Traversal a b+tinplate f = gfoldl (step f) pure+{-# INLINE tinplate #-}++step :: (Applicative f, Typeable b, Data d) => (b -> f b) -> f (d -> e) -> d -> f e+step f w d = w <*> case cast d of+  Just b  -> unsafeCoerce <$> f b+  Nothing -> tinplate f d+{-# INLINE step #-}++-------------------------------------------------------------------------------+-- Smart Traversal+-------------------------------------------------------------------------------++-- | Find every occurence of a given type @b@ recursively that doesn't require+-- passing through something of type @b@ using 'Data', while avoiding traversal+-- of areas that cannot contain a value of type @b@.+--+-- This is 'uniplate' with a more liberal signature.+template :: forall a b. (Data a, Typeable b) => Simple Traversal a b+template = uniplateData (fromOracle answer) where+  answer = hitTest (undefined :: a) (undefined :: b)+{-# INLINE template #-}++-- | Find descendants of type @a@ non-transitively, while avoiding computation of areas that cannot contain values of+-- type @a@ using 'Data'.+--+-- 'uniplate' is a useful default definition for 'Control.Plated.plate'+uniplate :: Data a => Simple Traversal a a+uniplate = template+{-# INLINE uniplate #-}++-- | 'biplate' performs like 'template', except when @a ~ b@, it returns itself and nothing else.+biplate :: forall a b. (Data a, Typeable b) => Simple Traversal a b+biplate = biplateData (fromOracle answer) where+  answer = hitTest (undefined :: a) (undefined :: b)+{-# INLINE biplate #-}++-------------------------------------------------------------------------------+-- Data Box+-------------------------------------------------------------------------------++data DataBox = forall a. Data a => DataBox+  { dataBoxKey :: TypeRep+  , _dataBoxVal :: a+  }++dataBox :: Data a => a -> DataBox+dataBox a = DataBox (typeOf a) a+{-# INLINE dataBox #-}++-- partial, caught elsewhere+sybChildren :: Data a => a -> [DataBox]+sybChildren x+  | isAlgType dt = do+    c <- dataTypeConstrs dt+    gmapQ dataBox (fromConstr c `asTypeOf` x)+  | otherwise = []+  where dt = dataTypeOf x++-------------------------------------------------------------------------------+-- HitMap+-------------------------------------------------------------------------------++type HitMap = HashMap TypeRep (HashSet TypeRep)++emptyHitMap :: HitMap+emptyHitMap = M.fromList+  [ (tRational, S.singleton tInteger)+  , (tInteger,  S.empty)+  ] where+  tRational = typeOf (undefined :: Rational)+  tInteger  = typeOf (undefined :: Integer )++insertHitMap :: DataBox -> HitMap -> HitMap+insertHitMap box hit = fixEq trans (populate box) <> hit where+  populate :: DataBox -> HitMap+  populate a = f a M.empty where+    f (DataBox k v) m+      | M.member k hit || M.member k m = m+      | cs <- sybChildren v = fs cs $ M.insert k (S.fromList $ map dataBoxKey cs) m+    fs []     m = m+    fs (x:xs) m = fs xs (f x m)++  trans :: HitMap -> HitMap+  trans m = M.map f m where+    f x = x <> foldMap g x+    g x = M.lookupDefault (hit ! x) x m++fixEq :: Eq a => (a -> a) -> a -> a+fixEq f = go where+  go x | x == x'   = x'+       | otherwise = go x'+       where x' = f x+{-# INLINE fixEq #-}++-- | inlineable 'unsafePerformIO'+inlinePerformIO :: IO a -> a+inlinePerformIO (IO m) = case m realWorld# of+  (# _, r #) -> r+{-# INLINE inlinePerformIO #-}++-------------------------------------------------------------------------------+-- Cache+-------------------------------------------------------------------------------++data Cache = Cache HitMap (HashMap TypeRep (HashMap TypeRep (Maybe Follower)))++cache :: IORef Cache+cache = unsafePerformIO $ newIORef $ Cache emptyHitMap M.empty+{-# NOINLINE cache #-}++readCacheFollower :: DataBox -> TypeRep -> Maybe Follower+readCacheFollower b@(DataBox kb _) ka = inlinePerformIO $+  readIORef cache >>= \ (Cache hm m) -> case M.lookup kb m >>= M.lookup ka of+    Just a -> return a+    Nothing -> E.try (return $! insertHitMap b hm) >>= \r -> case r of+      Left SomeException{}                         -> atomicModifyIORef cache $ \(Cache hm' n) -> (Cache hm' (insert2 kb ka Nothing n), Nothing)+      Right hm' | fol <- Just (follower kb ka hm') -> atomicModifyIORef cache $ \(Cache _ n) -> (Cache hm' (insert2 kb ka fol n),    fol)++insert2 :: TypeRep -> TypeRep -> a -> HashMap TypeRep (HashMap TypeRep a) -> HashMap TypeRep (HashMap TypeRep a)+insert2 x y v = M.insertWith (const $ M.insert y v) x (M.singleton y v)+{-# INLINE insert2 #-}++{-+readCacheHitMap :: DataBox -> Maybe HitMap+readCacheHitMap b@(DataBox kb _) = inlinePerformIO $+  readIORef cache >>= \ (Cache hm _) -> case M.lookup kb hm of+    Just _  -> return $ Just hm+    Nothing -> E.try (return $! insertHitMap b hm) >>= \r -> case r of+      Left SomeException{} -> return Nothing+      Right hm' -> atomicModifyIORef cache $ \(Cache _ follow) -> (Cache hm' follow, Just hm')+-}++-------------------------------------------------------------------------------+-- Answers+-------------------------------------------------------------------------------++data Answer a+  = Hit a+  | Follow+  | Miss+  deriving (Eq,Ord,Show,Read)++instance Functor Answer where+  fmap f (Hit a) = Hit (f a)+  fmap _ Follow  = Follow+  fmap _ Miss    = Miss++-------------------------------------------------------------------------------+-- Oracles+-------------------------------------------------------------------------------++newtype Oracle a = Oracle { fromOracle :: forall t. Typeable t => t -> Answer a }++instance Functor Oracle where+  fmap f (Oracle g) = Oracle (fmap f . g)++hitTest :: (Data a, Typeable b) => a -> b -> Oracle b+hitTest a b+  | kb <- typeOf b = case readCacheFollower (dataBox a) kb of+    Nothing -> Oracle $ \c ->+      if typeOf c == kb+      then Hit (unsafeCoerce c)+      else Follow+    Just p -> Oracle $ \c -> let kc = typeOf c in+      if kc == kb then Hit (unsafeCoerce c)+      else if p kc then Follow+      else Miss++-------------------------------------------------------------------------------+-- Traversals+-------------------------------------------------------------------------------+++biplateData :: forall f a b. (Applicative f, Data a, Typeable b) => (forall c. Typeable c => c -> Answer b) -> (b -> f b) -> a -> f a+biplateData o f a0 = go2 a0 where+  go :: Data d => d -> f d+  go a = gfoldl (\x y -> x <*> go2 y) pure a+  go2 :: Data d => d -> f d+  go2 a = case o a of+    Hit b  -> Unsafe.unsafeCoerce <$> f b+    Follow -> go a+    Miss   -> pure a+{-# INLINE biplateData #-}++uniplateData :: forall f a b. (Applicative f, Data a, Typeable b) => (forall c. Typeable c => c -> Answer b) -> (b -> f b) -> a -> f a+uniplateData o f a0 = go a0 where+  go :: Data d => d -> f d+  go a = gfoldl (\x y -> x <*> go2 y) pure a+  go2 :: Data d => d -> f d+  go2 a = case o a of+    Hit b  -> Unsafe.unsafeCoerce <$> f b+    Follow -> go a+    Miss   -> pure a+{-# INLINE uniplateData #-}++-------------------------------------------------------------------------------+-- Follower+-------------------------------------------------------------------------------++part :: (a -> Bool) -> HashSet a -> (HashSet a, HashSet a)+part p = S.filter p &&& S.filter (not . p)+{-# INLINE part #-}++type Follower = TypeRep -> Bool++follower :: TypeRep -> TypeRep -> HitMap -> Follower+follower a b m+  | S.null hit               = const False+  | S.null miss              = const True+  | S.size hit < S.size miss = \k -> S.member k hit+  | otherwise = \k -> not (S.member k miss)+  where (hit, miss) = part (\x -> S.member b (m ! x)) (S.insert a (m ! a))+
− src/Data/Either/Lens.hs 
@@ -1,41 +0,0 @@-{-# LANGUAGE LiberalTypeSynonyms #-}----------------------------------------------------------------------------------- |--- Module      :  Data.Either.Lens--- Copyright   :  (C) 2012 Edward Kmett--- License     :  BSD-style (see the file LICENSE)--- Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  provisional--- Portability :  portable------ Lenses for working with sums--------------------------------------------------------------------------------module Data.Either.Lens-  ( traverseLeft-  , traverseRight-  ) where--import Control.Applicative-import Control.Lens---- | A traversal for tweaking the left-hand value of an 'Either':------ @traverseLeft :: 'Applicative' f => (a -> f b) -> 'Either' a c -> f ('Either' b c)@-traverseLeft :: Traversal (Either a c) (Either b c) a b-traverseLeft f (Left a)  = Left <$> f a-traverseLeft _ (Right c) = pure $ Right c-{-# INLINE traverseLeft #-}---- | traverse the right-hand value of an 'Either':------ @'traverseRight' = 'Data.Traversable.traverse'@------ Unfortunately the instance for--- @'Data.Traversable.Traversable' ('Either' c)@ is still missing from base,--- so this can't just be 'Data.Traversable.traverse'------ @traverseRight :: 'Applicative' f => (a -> f b) -> 'Either' c a -> f ('Either' c a)@-traverseRight :: Traversal (Either c a) (Either c b) a b-traverseRight _ (Left c) = pure $ Left c-traverseRight f (Right a) = Right <$> f a-{-# INLINE traverseRight #-}
+ src/Data/HashSet/Lens.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE Rank2Types #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.HashSet.Lens+-- Copyright   :  (C) 2012 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+----------------------------------------------------------------------------+module Data.HashSet.Lens+  ( setmapped+  , setOf+  ) where++import Control.Lens.Getter+import Control.Lens.Internal+import Control.Lens.Setter+import Data.HashSet as HashSet+import Data.Hashable++-- | This 'Setter' can be used to change the type of a 'HashSet' by mapping+-- the elements to new values.+--+-- Sadly, you can't create a valid 'Traversal' for a 'Set', but you can+-- manipulate it by reading using 'folded' and reindexing it via 'setmap'.+--+-- >>> :m + Data.HashSet Control.Lens+-- >>> over setmapped (+1) (fromList [1,2,3,4])+-- fromList [2,3,4,5]+setmapped :: (Eq i, Hashable i, Eq j, Hashable j) => Setter (HashSet i) (HashSet j) i j+setmapped = sets HashSet.map+{-# INLINE setmapped #-}++-- | Construct a set from a 'Getter', 'Fold', 'Traversal', 'Lens' or 'Iso'.+--+-- >>> :m + Control.Lens+-- >>> setOf (folded._2) [("hello",1),("world",2),("!!!",3)]+-- fromList [1,2,3]+--+-- @+-- setOf :: 'Hashable' c         => 'Getter' a c           -> a -> 'HashSet' c+-- setOf :: ('Eq' c, 'Hashable' c) => 'Fold' a c             -> a -> 'HashSet' c+-- setOf :: 'Hashable' c         => 'Simple' 'Iso' a c       -> a -> 'HashSet' c+-- setOf :: 'Hashable' c         => 'Simple' 'Lens' a c      -> a -> 'HashSet' c+-- setOf :: ('Eq' c, 'Hashable' c) => 'Simple' 'Traversal' a c -> a -> 'HashSet' c+-- @+setOf :: Hashable c => Getting (HashSet c) a c -> a -> HashSet c+setOf l = runAccessor . l (Accessor . HashSet.singleton)+{-# INLINE setOf #-}
src/Data/IntMap/Lens.hs view
@@ -13,45 +13,13 @@ -- ---------------------------------------------------------------------------- module Data.IntMap.Lens-  ( at-  , traverseIntMap-  , traverseAt-  , traverseAtMin+  ( traverseAtMin   , traverseAtMax   ) where  import Control.Applicative as Applicative import Control.Lens import Data.IntMap as IntMap-import Data.Traversable---- | This 'Lens' can be used to read, write or delete the value associated with a key in an 'IntMap'.------ >>> fromList [(1,"hello")] ^.at 1--- Just "hello"------ >>> at 1 .~ Just "hello" $ IntMap.empty--- fromList [(1,"hello")]------ > at :: Int -> (Maybe v -> f (Maybe v)) -> IntMap v -> f (IntMap v)-at :: Int -> SimpleIndexedLens Int (IntMap v) (Maybe v)-at k = index $ \ f m -> (`go` m) <$> f k (IntMap.lookup k m) where-  go Nothing   = IntMap.delete k-  go (Just v') = IntMap.insert k v'-{-# INLINE at #-}---- | Traversal of an 'IntMap' indexed by the key.-traverseIntMap :: IndexedTraversal Int (IntMap v) (IntMap v') v v'-traverseIntMap = index $ \f -> sequenceA . mapWithKey f-{-# INLINE traverseIntMap #-}---- | Traverse the value at a given key in an IntMap------ > traverseAt :: Applicative f => Int -> (v -> f v) -> IntMap v -> f (IntMap v)--- > traverseAt k = at k . traverse-traverseAt :: Int -> SimpleIndexedTraversal Int (IntMap v) v-traverseAt k = at k <. traverse-{-# INLINE traverseAt #-}  -- | Traverse the value at the minimum key in a Map --
src/Data/IntSet/Lens.hs view
@@ -10,35 +10,22 @@ -- ---------------------------------------------------------------------------- module Data.IntSet.Lens-  ( contains-  , members+  ( members   , setmapped   , setOf   ) where -import Control.Applicative import Control.Lens import Control.Lens.Internal import Data.IntSet as IntSet --- | This 'Lens' can be used to read, write or delete a member of an 'IntSet'------ > ghci> contains 3 +~ False $ fromList [1,2,3,4]--- > fromList [1,2,4]------ @contains :: 'Functor' f => 'Int' -> ('Bool' -> f 'Bool') -> 'IntSet' -> f 'IntSet'@-contains :: Int -> Simple Lens IntSet Bool-contains k f s = go <$> f (IntSet.member k s) where-  go False = IntSet.delete k s-  go True  = IntSet.insert k s-{-# INLINE contains #-}- -- | IntSet isn't Foldable, but this 'Fold' can be used to access the members of an 'IntSet'. -- -- >>> sumOf members $ setOf folded [1,2,3,4] -- 10 members :: Fold IntSet Int members = folding IntSet.toAscList+{-# INLINE members #-}  -- | This 'Setter' can be used to change the contents of an 'IntSet' by mapping -- the elements to new values.@@ -51,6 +38,7 @@ -- fromList [2,3,4,5] setmapped :: Simple Setter IntSet Int setmapped = sets IntSet.map+{-# INLINE setmapped #-}  -- | Construct an 'IntSet' from a 'Getter', 'Fold', 'Traversal', 'Lens' or 'Iso'. --@@ -67,3 +55,4 @@ -- @ setOf :: Getting IntSet a Int -> a -> IntSet setOf l = runAccessor . l (Accessor . IntSet.singleton)+{-# INLINE setOf #-}
src/Data/Map/Lens.hs view
@@ -12,49 +12,14 @@ -- ---------------------------------------------------------------------------- module Data.Map.Lens-  ( at-  , traverseMap-  , traverseAt-  , traverseAtMin+  ( traverseAtMin   , traverseAtMax   ) where  import Control.Applicative as Applicative-import Control.Lens.Traversal import Control.Lens.Indexed-import Control.Lens.IndexedLens import Control.Lens.IndexedTraversal import Data.Map as Map-import Data.Traversable---- | This 'Lens' can be used to read, write or delete the value associated with a key in a 'Map'.------ >>> :m + Control.Lens Data.Map.Lens------ >>> Map.fromList [("hello",12)] ^.at "hello"--- Just 12------ >>> at 10 .~ Just "hello" $ Map.empty--- fromList [(10,"hello")]------ > at :: Ord k => k -> (Maybe v -> f (Maybe v)) -> Map k v -> f (Map k v)-at :: Ord k => k -> SimpleIndexedLens k (Map k v) (Maybe v)-at k = index $ \f m -> (`go` m) <$> f k (Map.lookup k m) where-  go Nothing   = Map.delete k-  go (Just v') = Map.insert k v'-{-# INLINE at #-}---- | Traversal of a 'Map' indexed by the key.-traverseMap :: IndexedTraversal k (Map k v) (Map k v') v v'-traverseMap = index $ \f -> sequenceA . mapWithKey f---- | Traverse the value at a given key in a Map------ > traverseAt :: (Applicative f, Ord k) => k -> (v -> f v) -> Map k v -> f (Map k v)--- > traverseAt k = valueAt k . traverse-traverseAt :: Ord k => k -> SimpleIndexedTraversal k (Map k v) v-traverseAt k = at k <. traverse-{-# INLINE traverseAt #-}  -- | Traverse the value at the minimum key in a Map. --
src/Data/Monoid/Lens.hs view
@@ -23,15 +23,15 @@  -- | Modify the target of a monoidally valued by 'mappend'ing another value. ----- >>> :m + Control.Lens Data.Pair.Lens+-- >>> :m + Control.Lens -- >>> both <>~ "!!!" $ ("hello","world") -- ("hello!!!","world!!!") -- -- @--- (\<\>~) :: 'Monoid' c => 'Setter' a b c c -> c -> a -> b--- (\<\>~) :: 'Monoid' c => 'Iso' a b c c -> c -> a -> b--- (\<\>~) :: 'Monoid' c => 'Lens' a b c c -> c -> a -> b--- (\<\>~) :: 'Monoid' c => 'Traversal' a b c c -> c -> a -> b+-- ('<>~') :: 'Monoid' c => 'Setter' a b c c -> c -> a -> b+-- ('<>~') :: 'Monoid' c => 'Iso' a b c c -> c -> a -> b+-- ('<>~') :: 'Monoid' c => 'Lens' a b c c -> c -> a -> b+-- ('<>~') :: 'Monoid' c => 'Traversal' a b c c -> c -> a -> b -- @ (<>~) :: Monoid c => Setting a b c c -> c -> a -> b l <>~ n = over l (`mappend` n)@@ -40,10 +40,10 @@ -- | Modify the target(s) of a 'Simple' 'Lens', 'Iso', 'Setter' or 'Traversal' by 'mappend'ing a value. -- -- @--- (\<\>=) :: ('MonadState' a m, 'Monoid' b) => 'Simple' 'Setter' a b -> b -> m ()--- (\<\>=) :: ('MonadState' a m, 'Monoid' b) => 'Simple' 'Iso' a b -> b -> m ()--- (\<\>=) :: ('MonadState' a m, 'Monoid' b) => 'Simple' 'Lens' a b -> b -> m ()--- (\<\>=) :: ('MonadState' a m, 'Monoid' b) => 'Simple' 'Traversal' a b -> b -> m ()+-- ('<>=') :: ('MonadState' a m, 'Monoid' b) => 'Simple' 'Setter' a b -> b -> m ()+-- ('<>=') :: ('MonadState' a m, 'Monoid' b) => 'Simple' 'Iso' a b -> b -> m ()+-- ('<>=') :: ('MonadState' a m, 'Monoid' b) => 'Simple' 'Lens' a b -> b -> m ()+-- ('<>=') :: ('MonadState' a m, 'Monoid' b) => 'Simple' 'Traversal' a b -> b -> m () -- @ (<>=) :: (MonadState a m, Monoid b) => SimpleSetting a b -> b -> m () l <>= b = State.modify (l <>~ b)
− src/Data/Pair/Lens.hs 
@@ -1,33 +0,0 @@-{-# LANGUAGE LiberalTypeSynonyms #-}-{-# LANGUAGE Rank2Types #-}--------------------------------------------------------------------------------- |--- Module      :  Data.Pair.Lens--- Copyright   :  (C) 2012 Edward Kmett--- License     :  BSD-style (see the file LICENSE)--- Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  provisional--- Portability :  portable------ Lenses for working with products.------ Due to their ubiquity, '_1' and '_2' are defined in @Control.Lens@.------------------------------------------------------------------------------module Data.Pair.Lens-  ( both-  , value-  ) where--import Control.Applicative-import Control.Lens---- | Traverse both parts of a tuple with matching types.-both :: Traversal (a,a) (b,b) a b-both f (a,a') = (,) <$> f a <*> f a'-{-# INLINE both #-}---- | This provides a 'Traversal' that checks a predicate on a key before--- allowing you to traverse into a value.-value :: (k -> Bool) -> SimpleIndexedTraversal k (k, v) v-value p = index $ \ f kv@(k,v) -> if p k then (,) k <$> f k v else pure kv-{-# INLINE value #-}
src/Data/Sequence/Lens.hs view
@@ -11,7 +11,7 @@ -- ---------------------------------------------------------------------------- module Data.Sequence.Lens-  ( at, viewL, viewR+  ( ordinal, viewL, viewR   , traverseHead, traverseTail   , traverseLast, traverseInit   , traverseTo, traverseFrom@@ -22,20 +22,18 @@ import Control.Lens as Lens import Data.Monoid import Data.Sequence as Seq-import Data.Traversable  -- | A 'Lens' that can access the @n@th element of a 'Seq'. ----- Note: This is only a legal lens if there is such an element!----at :: Int -> SimpleIndexedLens Int (Seq a) a-at i = Lens.index $ \ f m -> (\a -> update i a m) <$> f i (Seq.index m i)+-- Note: This is only a legal lens if there is already such an element!+ordinal :: Int -> SimpleIndexedLens Int (Seq a) a+ordinal i = Lens.index $ \ f m -> (\a -> update i a m) <$> f i (Seq.index m i)  -- * Sequence isomorphisms  -- | A 'Seq' is isomorphic to a 'ViewL' ----- > viewl m = m^.viewL+-- @'viewl' m = m '^.' 'viewL'@ viewL :: Iso (Seq a) (Seq b) (ViewL a) (ViewL b) viewL = isos viewl unviewl viewl unviewl where @@ -46,7 +44,7 @@  -- | A 'Seq' is isomorphic to a 'ViewR' ----- > viewr m = m^.viewR+-- @'viewr' m = m '^.' 'viewR'@ viewR :: Iso (Seq a) (Seq b) (ViewR a) (ViewR b) viewR = isos viewr unviewr viewr unviewr where {-# INLINE viewR #-}@@ -55,10 +53,6 @@ unviewr EmptyR = mempty unviewr (as :> a) = as |> a -traverseSeq :: IndexedTraversal Int (Seq a) (Seq b) a b-traverseSeq = Lens.index $ \ f -> sequenceA . Seq.mapWithIndex f-{-# INLINE traverseSeq #-}- -- * Traversals  -- | Traverse the head of a 'Seq'@@ -71,7 +65,7 @@ -- | Traverse the tail of a 'Seq' traverseTail :: SimpleIndexedTraversal Int (Seq a) a traverseTail = Lens.index $ \f m -> case viewl m of-  a :< as -> (a <|) <$> withIndex traverseSeq (f . (+1)) as+  a :< as -> (a <|) <$> itraverse (f . (+1)) as   EmptyL  -> pure m {-# INLINE traverseTail #-} @@ -85,25 +79,25 @@ -- | Traverse all but the last element of a 'Seq' traverseInit :: SimpleIndexedTraversal Int (Seq a) a traverseInit = Lens.index $ \ f m -> case viewr m of-  as :> a -> (|> a) <$> withIndex traverseSeq f as+  as :> a -> (|> a) <$> itraverse f as   EmptyR  -> pure m {-# INLINE traverseInit #-}  -- | Traverse the first @n@ elements of a 'Seq' traverseTo :: Int -> SimpleIndexedTraversal Int (Seq a) a traverseTo n = Lens.index $ \f m -> case Seq.splitAt n m of-  (l,r) -> (>< r) <$> withIndex traverseSeq f l+  (l,r) -> (>< r) <$> itraverse f l {-# INLINE traverseTo #-}  -- | Traverse all but the first @n@ elements of a 'Seq' traverseFrom :: Int -> SimpleIndexedTraversal Int (Seq a) a traverseFrom n = Lens.index $ \ f m -> case Seq.splitAt n m of-  (l,r) -> (l ><) <$> withIndex traverseSeq (f . (+n)) r+  (l,r) -> (l ><) <$> itraverse (f . (+n)) r {-# INLINE traverseFrom #-}  -- | Travere all the elements numbered from @i@ to @j@ of a 'Seq' traverseSlice :: Int -> Int -> SimpleIndexedTraversal Int (Seq a) a traverseSlice i j = Lens.index $ \ f s -> case Seq.splitAt i s of   (l,mr) -> case Seq.splitAt (j-i) mr of-     (m, r) -> (\n -> l >< n >< r) <$> withIndex traverseSeq (f . (+i)) m+     (m, r) -> (\n -> l >< n >< r) <$> itraverse (f . (+i)) m {-# INLINE traverseSlice #-}
src/Data/Set/Lens.hs view
@@ -10,31 +10,15 @@ -- ---------------------------------------------------------------------------- module Data.Set.Lens-  ( contains-  , setmapped+  ( setmapped   , setOf   ) where -import Control.Applicative import Control.Lens.Getter import Control.Lens.Internal import Control.Lens.Setter-import Control.Lens.Type import Data.Set as Set --- | This 'Lens' can be used to read, write or delete a member of a 'Set'------ >>> :m + Data.Set.Lens Control.Lens--- >>> contains 3 .~ False $ Set.fromList [1,2,3,4]--- fromList [1,2,4]------ > contains :: Ord k => k -> (Bool -> f Bool) -> Set k -> f (Set k)-contains :: Ord k => k -> Simple Lens (Set k) Bool-contains k f s = go <$> f (Set.member k s) where-  go False = Set.delete k s-  go True  = Set.insert k s-{-# INLINE contains #-}- -- | This 'Setter' can be used to change the type of a 'Set' by mapping -- the elements to new values. --@@ -46,6 +30,7 @@ -- fromList [2,3,4,5] setmapped :: (Ord i, Ord j) => Setter (Set i) (Set j) i j setmapped = sets Set.map+{-# INLINE setmapped #-}  -- | Construct a set from a 'Getter', 'Fold', 'Traversal', 'Lens' or 'Iso'. --@@ -62,3 +47,4 @@ -- @ setOf :: Getting (Set c) a c -> a -> Set c setOf l = runAccessor . l (Accessor . Set.singleton)+{-# INLINE setOf #-}
src/Data/Text/Lazy/Lens.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-} ----------------------------------------------------------------------------- -- | -- Module      :  Data.Text.Lazy.Lens@@ -16,10 +18,12 @@ import Control.Lens import Data.Text.Lazy --- | Pack (or unpack) 'Text'.+-- | Pack (or unpack) lazy 'Text'. ----- > pack x = x^.packed--- > unpack x = x^.from packed+-- @+-- 'pack' x = x '^.' 'packed'+-- 'unpack' x = x '^.' 'from' 'packed'+-- @ packed :: Simple Iso String Text packed = iso pack unpack {-# INLINE packed #-}@@ -28,6 +32,6 @@ -- | Traverse the individual characters in a 'Text'. -- -- > anyOf text (=='c') :: Text -> Bool-text :: Simple Traversal Text Char-text = from packed . traverse+text :: SimpleIndexedTraversal Int Text Char+text = from packed .> itraversed {-# INLINE text #-}
src/Data/Text/Lens.hs view
@@ -10,26 +10,40 @@ -- ---------------------------------------------------------------------------- module Data.Text.Lens-  ( packed-  , text+  ( IsText(..)   ) where -import Control.Lens-import Data.Text-import Data.List.Lens+import           Control.Lens+import           Data.Text as Strict+import qualified Data.Text.Strict.Lens as Strict+import           Data.Text.Lazy as Lazy+import qualified Data.Text.Lazy.Lens as Lazy --- | Pack (or unpack) 'Text'.------ > pack x = x^.packed--- > unpack x = x^.from packed-packed :: Simple Iso String Text-packed = iso pack unpack-{-# INLINE packed #-}-{-# SPECIALIZE packed :: Simple Lens String Text #-}+-- | Traversals for strict or lazy 'Text'+class IsText t where+  -- | 'pack' (or 'unpack') strict or lazy 'Text'.+  --+  -- @+  -- 'pack' x = x '^.' 'packed'+  -- 'unpack' x = x '^.' 'from' 'packed'+  -- @+  packed :: Simple Iso String t --- | Traverse the individual characters in a either strict or lazy 'Text'.------ > anyOf text (=='c') :: Text -> Bool-text :: SimpleIndexedTraversal Int Text Char-text = from packed .> traverseList-{-# INLINE text #-}+  -- | Traverse the individual characters in strict or lazy 'Text'.+  text :: SimpleIndexedTraversal Int t Char+  text = from packed .> itraversed+  {-# INLINE text #-}++instance IsText Strict.Text where+  packed = Strict.packed+  {-# INLINE packed #-}+  {-# SPECIALIZE packed :: Simple Lens String Strict.Text #-}+  text = Strict.text+  {-# INLINE text #-}++instance IsText Lazy.Text where+  packed = Lazy.packed+  {-# INLINE packed #-}+  {-# SPECIALIZE packed :: Simple Lens String Lazy.Text #-}+  text = Lazy.text+  {-# INLINE text #-}
+ src/Data/Text/Strict/Lens.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE FlexibleContexts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Text.Strict.Lens+-- Copyright   :  (C) 2012 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+----------------------------------------------------------------------------+module Data.Text.Strict.Lens+  ( packed+  , text+  ) where++import Control.Lens+import Data.Text++-- | 'pack' (or 'unpack') strict 'Text'.+--+-- @+-- 'pack' x = x '^.' 'packed'+-- 'unpack' x = x '^.' 'from' 'packed'+-- @+packed :: Simple Iso String Text+packed = iso pack unpack+{-# INLINE packed #-}+{-# SPECIALIZE packed :: Simple Lens String Text #-}++-- | Traverse the individual characters in strict 'Text'.+--+-- >>> anyOf text (=='o') $ "hello"^.packed+-- True+text :: SimpleIndexedTraversal Int Text Char+text = from packed .> itraversed+{-# INLINE text #-}
src/Data/Tree/Lens.hs view
@@ -12,7 +12,7 @@  module Data.Tree.Lens   ( root-  , children+  , branches   ) where  import Control.Lens@@ -27,6 +27,6 @@  -- | A 'Traversal' of the direct descendants of the root of a 'Tree' -- indexed by its position in the list of children-children :: SimpleIndexedTraversal Int (Tree a) (Tree a)-children = index $ \ f (Node a as) -> Node a <$> withIndex traverseList f as-{-# INLINE children #-}+branches :: SimpleIndexedTraversal Int (Tree a) (Tree a)+branches = index $ \ f (Node a as) -> Node a <$> withIndex traverseList f as+{-# INLINE branches #-}
+ src/Data/Typeable/Lens.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE Rank2Types #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Typeable.Lens+-- Copyright   :  (C) 2012 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  Rank2Types+--+----------------------------------------------------------------------------+module Data.Typeable.Lens+  ( _cast+  , _gcast+  ) where++import Control.Applicative+import Control.Lens+import Data.Typeable+import Unsafe.Coerce as Unsafe++-- | A 'Simple' 'Traversal' for working with a 'cast' of a 'Typeable' value.+_cast :: (Typeable a, Typeable b) => Simple Traversal a b+_cast f a = case cast a of+  Just b -> Unsafe.unsafeCoerce <$> f b+  Nothing -> pure a+{-# INLINE _cast #-}++-- | A 'Simple' 'Traversal' for working with a 'gcast' of a 'Typeable' value.+_gcast :: (Typeable a, Typeable b) => Simple Traversal (c a) (c b)+_gcast f a = case gcast a of+  Just b -> Unsafe.unsafeCoerce <$> f b+  Nothing -> pure a+{-# INLINE _gcast #-}
src/GHC/Generics/Lens.hs view
@@ -29,7 +29,7 @@     generic   , generic1   -- * Generic Traversal-  , every+  , tinplate   , GTraversal   ) where @@ -55,42 +55,41 @@ -- | A 'GHC.Generics.Generic' 'Traversal' that visits every occurence -- of something 'Typeable' anywhere in a container. ----- >>> allOf every (=="Hello") (1::Int,2::Double,(),"Hello",["Hello"])+-- >>> allOf tinplate (=="Hello") (1::Int,2::Double,(),"Hello",["Hello"]) -- True ----- >>> mapMOf_ every putStrLn ("hello",[(2 :: Int, "world!")])+-- >>> mapMOf_ tinplate putStrLn ("hello",[(2 :: Int, "world!")]) -- hello -- world!-every :: (Generic a, GTraversal (Rep a), Typeable b) => Simple Traversal a b-every = generic . everyr True+tinplate :: (Generic a, GTraversal (Rep a), Typeable b) => Simple Traversal a b+tinplate = generic . tinplated True --- | Used to traverse 'Generic' data by 'every'.+maybeArg1Of :: Maybe c -> (c -> d) -> Maybe c+maybeArg1Of = const++-- | Used to traverse 'Generic' data by 'uniplate'. class GTraversal f where-  everyr :: Typeable b => Bool -> Simple Traversal (f a) b+  tinplated :: Typeable b => Bool -> Simple Traversal (f a) b  instance (Generic a, GTraversal (Rep a), Typeable a) => GTraversal (K1 i a) where-  everyr rec f (K1 a) = case cast a `maybeArg1Of` f of+  tinplated rec f (K1 a) = case cast a `maybeArg1Of` f of     Just b  -> K1 . fromJust . cast <$> f b-    Nothing | rec       -> K1 <$> fmap generic (everyr False) f a+    Nothing | rec       -> K1 <$> fmap generic (tinplated False) f a             | otherwise -> pure $ K1 a-    where-      maybeArg1Of :: Maybe c -> (c -> d) -> Maybe c-      maybeArg1Of = const  instance GTraversal U1 where-  everyr _ _ U1 = pure U1+  tinplated _ _ U1 = pure U1  instance (GTraversal f, GTraversal g) => GTraversal (f :*: g) where-  everyr _ f (x :*: y) = (:*:) <$> everyr True f x <*> everyr True f y+  tinplated _ f (x :*: y) = (:*:) <$> tinplated True f x <*> tinplated True f y  instance (GTraversal f, GTraversal g) => GTraversal (f :+: g) where-  everyr _ f (L1 x) = L1 <$> everyr True f x-  everyr _ f (R1 x) = R1 <$> everyr True f x+  tinplated _ f (L1 x) = L1 <$> tinplated True f x+  tinplated _ f (R1 x) = R1 <$> tinplated True f x  instance GTraversal a => GTraversal (M1 i c a) where-  everyr rec f (M1 x) = M1 <$> everyr rec f x+  tinplated rec f (M1 x) = M1 <$> tinplated rec f x  -- ? instance (Traversable f, GTraversal g) => GTraversal (f :.: g) where-  everyr _ f (Comp1 fgp) = Comp1 <$> traverse (everyr True f) fgp-+  tinplated _ f (Comp1 fgp) = Comp1 <$> traverse (tinplated True f) fgp
src/Language/Haskell/TH/Lens.hs view
@@ -29,8 +29,8 @@ import Control.Lens.Setter import Control.Lens.Type import Control.Lens.Traversal+import Control.Lens.IndexedLens import Data.Map as Map hiding (toList,map)-import Data.Map.Lens import Data.Maybe (fromMaybe) import Data.Monoid import Data.Set as Set hiding (toList,map)
src/System/FilePath/Lens.hs view
@@ -30,15 +30,15 @@  -- | Modify the path by adding another path. ----- >>> :m + Control.Lens Data.Pair.Lens+-- >>> :m + Control.Lens -- >>> both </>~ "!!!" $ ("hello","world") -- ("hello/!!!","world/!!!") -- -- @--- (\</\>~) :: 'Setter' a b 'FilePath' 'FilePath' -> 'FilePath' -> a -> b--- (\</\>~) :: 'Iso' a b 'FilePath' 'FilePath' -> 'FilePath' -> a -> b--- (\</\>~) :: 'Lens' a b 'FilePath' 'FilePath' -> 'FilePath' -> a -> b--- (\</\>~) :: 'Traversal' a b 'FilePath' 'FilePath' -> 'FilePath' -> a -> b+-- ('</>~') :: 'Setter' a b 'FilePath' 'FilePath' -> 'FilePath' -> a -> b+-- ('</>~') :: 'Iso' a b 'FilePath' 'FilePath' -> 'FilePath' -> a -> b+-- ('</>~') :: 'Lens' a b 'FilePath' 'FilePath' -> 'FilePath' -> a -> b+-- ('</>~') :: 'Traversal' a b 'FilePath' 'FilePath' -> 'FilePath' -> a -> b -- @ (</>~) :: Setting a b FilePath FilePath -> FilePath -> a -> b l </>~ n = over l (</> n)@@ -48,10 +48,10 @@ -- | Modify the target(s) of a 'Simple' 'Lens', 'Iso', 'Setter' or 'Traversal' by adding a path. -- -- @--- (\</\>=) :: 'MonadState' a m => 'Simple' 'Setter' a 'FilePath' -> 'FilePath' -> m ()--- (\</\>=) :: 'MonadState' a m => 'Simple' 'Iso' a 'FilePath' -> 'FilePath' -> m ()--- (\</\>=) :: 'MonadState' a m => 'Simple' 'Lens' a 'FilePath' -> 'FilePath' -> m ()--- (\</\>=) :: 'MonadState' a m => 'Simple' 'Traversal' a 'FilePath' -> 'FilePath' -> m ()+-- ('</>=') :: 'MonadState' a m => 'Simple' 'Setter' a 'FilePath' -> 'FilePath' -> m ()+-- ('</>=') :: 'MonadState' a m => 'Simple' 'Iso' a 'FilePath' -> 'FilePath' -> m ()+-- ('</>=') :: 'MonadState' a m => 'Simple' 'Lens' a 'FilePath' -> 'FilePath' -> m ()+-- ('</>=') :: 'MonadState' a m => 'Simple' 'Traversal' a 'FilePath' -> 'FilePath' -> m () -- @ (</>=) :: MonadState a m => SimpleSetting a FilePath -> FilePath -> m () l </>= b = State.modify (l </>~ b)@@ -77,15 +77,15 @@  -- | Modify the path by adding extension. ----- >>> :m + Control.Lens Data.Pair.Lens+-- >>> :m + Control.Lens -- >>> both <.>~ "!!!" $ ("hello","world") -- ("hello.!!!","world.!!!") -- -- @--- (\<.\>~) :: 'Setter' a b 'FilePath' 'FilePath' -> 'String' -> a -> b--- (\<.\>~) :: 'Iso' a b 'FilePath' 'FilePath' -> 'String' -> a -> b--- (\<.\>~) :: 'Lens' a b 'FilePath' 'FilePath' -> 'String' -> a -> b--- (\<.\>~) :: 'Traversal' a b 'FilePath' 'FilePath' -> 'String' -> a -> b+-- ('<.>~') :: 'Setter' a b 'FilePath' 'FilePath' -> 'String' -> a -> b+-- ('<.>~') :: 'Iso' a b 'FilePath' 'FilePath' -> 'String' -> a -> b+-- ('<.>~') :: 'Lens' a b 'FilePath' 'FilePath' -> 'String' -> a -> b+-- ('<.>~') :: 'Traversal' a b 'FilePath' 'FilePath' -> 'String' -> a -> b -- @ (<.>~) :: Setting a b FilePath FilePath -> String -> a -> b l <.>~ n = over l (<.> n)@@ -95,10 +95,10 @@ -- | Modify the target(s) of a 'Simple' 'Lens', 'Iso', 'Setter' or 'Traversal' by adding an extension. -- -- @--- (\<.\>=) :: 'MonadState' a m => 'Simple' 'Setter' a 'FilePath' -> 'String' -> m ()--- (\<.\>=) :: 'MonadState' a m => 'Simple' 'Iso' a 'FilePath' -> 'String' -> m ()--- (\<.\>=) :: 'MonadState' a m => 'Simple' 'Lens' a 'FilePath' -> 'String' -> m ()--- (\<.\>=) :: 'MonadState' a m => 'Simple' 'Traversal' a 'FilePath' -> 'String' -> m ()+-- ('<.>=') :: 'MonadState' a m => 'Simple' 'Setter' a 'FilePath' -> 'String' -> m ()+-- ('<.>=') :: 'MonadState' a m => 'Simple' 'Iso' a 'FilePath' -> 'String' -> m ()+-- ('<.>=') :: 'MonadState' a m => 'Simple' 'Lens' a 'FilePath' -> 'String' -> m ()+-- ('<.>=') :: 'MonadState' a m => 'Simple' 'Traversal' a 'FilePath' -> 'String' -> m () -- @ (<.>=) :: MonadState a m => SimpleSetting a FilePath -> String -> m () l <.>= b = State.modify (l <.>~ b)
tests/properties.hs view
@@ -12,9 +12,7 @@ import Test.QuickCheck import Test.QuickCheck.All import Test.QuickCheck.Function-import Data.Pair.Lens-import Data.Either.Lens-import Data.Text.Lens+import Data.Text.Strict.Lens  setter_id :: Eq a => Simple Setter a b -> a -> Bool setter_id l a = runIdentity (l Identity a) == a