packages feed

lens 1.4.1 → 1.5

raw patch · 29 files changed

+2982/−2663 lines, 29 filesdep +doctestdep ~basedep ~transformers

Dependencies added: doctest

Dependency ranges changed: base, transformers

Files

examples/Pong.hs view
@@ -1,27 +1,30 @@-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE TemplateHaskell, Rank2Types #-}  import Control.Applicative ((<$>), (<*>)) import Control.Lens-import Control.Lens.TH+import Control.Lens.TH (makeLenses) import Control.Monad.State  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+ -- Some global constants  gameSize      = 300 windowSize    = 480 ballRadius    = 0.02-initialSpeed  = (0.8, 0.3) speedIncrease = 1.1+initialSpeed  = 0.5 paddleWidth   = 0.02 paddleHeight  = 0.3 paddleSpeed   = 1-textSize      = 0.3 / gameSize+textSize      = 0.001  -- Pure data type for representing the game state @@ -31,25 +34,38 @@   , _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   } -initial :: Pong-initial = Pong (0, 0) initialSpeed 0 0 (0, 0) empty- -- Some nice lenses to go with it makeLenses ''Pong --- I'm just renaming the tuple lenses for enhanced clarity with points/vectors+-- Renamed tuple lenses for enhanced clarity with points/vectors _x = _1 _y = _2 --- This will be in Data.Pair.Lens soon-both :: Traversal (a,a) (b,b) a b-both f (x,y) = (,) <$> f x <*> f y+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+ -- Game update logic  update :: Float -> Pong -> Pong@@ -61,46 +77,42 @@ -- Move the ball by adding its current speed updateBall :: Float -> State Pong () updateBall time = do-  speed <- use ballSpeed-  ballPos += speed `mul` time+  (u, v) <- use ballSpeed+  ballPos += (time * u, time * v)    -- Make sure it doesn't leave the playing area-  ballPos.both %= clampPad ballRadius-- where-   (a,b) `mul` c = (c*a, c*b)-   infixl 7 `mul`+  ballPos.both %= clamp ballRadius  -- Update the paddles updatePaddles :: Float -> State Pong () updatePaddles time = do   p <- get +  let paddleMovement = time * paddleSpeed+  let keyPressed key = p^.keys.contains (SpecialKey key)+   -- Update the player's paddle based on keys-  when (SpecialKey KeyUp `isIn` p^.keys) $-    paddle1 += paddleSpeed * time+  when (keyPressed KeyUp)   $ paddle1 += paddleMovement+  when (keyPressed KeyDown) $ paddle1 -= paddleMovement -  when (SpecialKey KeyDown `isIn` p^.keys) $-    paddle1 -= paddleSpeed * time+  -- Calculate the optimal position+  let optimal = hitPos (p^.ballPos) (p^.ballSpeed)+  let dist    = optimal - p^.paddle2 -  -- Update the CPU's paddle based on the ball's relative position-  case compare (p^.ballPos._y) (p^.paddle2) of-    GT -> paddle2 += paddleSpeed * time-    LT -> paddle2 -= paddleSpeed * time-    _  -> return ()+  -- 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-  paddle2 %= clamp-- where-   clamp = clampPad (paddleHeight/2)-   isIn  = member-   infixl 7 `isIn`+  paddle1 %= clamp (paddleHeight/2)+  paddle2 %= clamp (paddleHeight/2)  -- Clamp to the region (-1, 1) but with padding-clampPad :: Float -> Float -> Float-clampPad pad = max (pad - 1) . min (1 - pad)+clamp :: Float -> Float -> Float+clamp pad = max (pad - 1) . min (1 - pad)  -- Check for collisions and/or scores checkBounds :: State Pong ()@@ -109,57 +121,55 @@   let (x,y) = p^.ballPos    -- Check for collisions with the top or bottom-  when (abs y >= top) $+  when (abs y >= edge) $     ballSpeed._y %= negate    -- Check for collisions with paddles-  let check l = y >= p^.l - paddleHeight/2 && y <= p^.l + paddleHeight/2-      collide = do+  let { check paddle other =+    if y >= p^.paddle - paddleHeight/2 && y <= p^.paddle + paddleHeight/2+      then do         ballSpeed._x   %= negate         ballSpeed.both *= speedIncrease -  when (x <= left) $-    if check paddle1-      then collide       else do-        score._2 += 1+        score.other += 1         reset+  } -  when (x >= right) $-    if check paddle2-      then collide-      else do-        score._1 += 1-        reset+  when (x >=  edge) $ check paddle2 _1+  when (x <= -edge) $ check paddle1 _2    where-    top   = 1 - ballRadius-    left  = ballRadius + paddleWidth/2 - 1-    right = -left+    edge = 1 - ballRadius  -- Reset the game reset :: State Pong () reset = do-  ballPos   ^= initial^.ballPos-  ballSpeed ^= initial^.ballSpeed+  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` (-1, p^.paddle1)-  , drawPaddle `at` ( 1, p^.paddle2)+  , drawPaddle `at` (-paddleX, p^.paddle1)+  , drawPaddle `at` ( paddleX, p^.paddle2)    -- Score and playing field-  , scale textSize textSize (p^.score.pretty.to text) `at` (-0.1, 0.85)+  , drawScore (p^.score) `at` (-0.1, 0.85)   , rectangleWire 2 2   ]   where-    -- Pretty printing lens-    pretty = to (\(x,y) -> show x ++ " " ++ show y)-    p `at` (x,y) = translate x y p-    infixr 1 `at`+    paddleX = 1 + paddleWidth/2+    p `at` (x,y) = translate x y p; infixr 1 `at`  drawPaddle :: Picture drawPaddle = rectangleSolid paddleWidth paddleHeight@@ -167,18 +177,35 @@ 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 Down _ _) = keys %~ insert k-handle (EventKey k Up   _ _) = keys %~ delete k+handle (EventKey k s _ _) = keys.contains k .~ (s == Down) handle _ = id  -- The main program action -main = play display backColor fps initial draw handle update+main = do+  v:vs <- startingSpeeds+  let world = ballSpeed .~ v $ vectors .~ vs $ initial+  play display backColor fps world draw handle update+   where-    -- display   = InWindow "Pong!" (windowSize, windowSize) (800, 600)-    display   = FullScreen (800,600)+    display   = InWindow "Pong!" (windowSize, windowSize) (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/Pong2.hs 
@@ -1,200 +0,0 @@-{-# LANGUAGE TemplateHaskell, NoMonomorphismRestriction #-}--import Control.Applicative ((<$>), (<*>))-import Control.Lens-import Control.Lens.TH-import Control.Monad.State--import Data.Set (Set, member, empty, insert, delete)--import Graphics.Gloss-import Graphics.Gloss.Interface.Pure.Game---- Some global constants--gameSize      = 300-windowSize    = 480-ballRadius    = 0.02-initialSpeed  = (0.5, 0.3)-speedIncrease = 1.1-paddleWidth   = 0.02-paddleHeight  = 0.3-paddleSpeed   = 1-textSize      = 0.3 / gameSize---- Pure data type for representing the game state--data Pong = Pong-  { _ballPos   :: Point-  , _ballSpeed :: Vector-  , _paddle1   :: Float-  , _paddle2   :: Float-  , _score     :: (Int, Int)--  -- Since gloss doesn't cover this, we store the set of pressed keys-  , _keys      :: Set Key-  }--initial :: Pong-initial = Pong (0, 0) initialSpeed 0 0 (0, 0) empty---- Some nice lenses to go with it-makeLenses ''Pong---- I'm just renaming the tuple lenses for enhanced clarity with points/vectors-_x = _1-_y = _2---- This will be in Data.Pair.Lens soon-both :: Traversal (a,a) (b,b) a b-both f (x,y) = (,) <$> f x <*> f y---- 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---- 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-  speed <- use ballSpeed-  ballPos += speed `mul` time--  -- Make sure it doesn't leave the playing area-  ballPos.both %= clampPad ballRadius-- where-   (a,b) `mul` c = (c*a, c*b)-   infixl 7 `mul`---- Update the paddles-updatePaddles :: Float -> State Pong ()-updatePaddles time = do-  p <- get--  -- Update the player's paddle based on keys-  when (SpecialKey KeyUp `isIn` p^.keys) $-    paddle1 += paddleSpeed * time--  when (SpecialKey KeyDown `isIn` p^.keys) $-    paddle1 -= paddleSpeed * time--  -- Calculate the optimal position-  let optimal = hitPos (p^.ballPos) (p^.ballSpeed)--  -- Move the CPU's paddle towards this optimal position-  case compare optimal (p^.paddle2) of-    GT -> paddle2 += paddleSpeed * time-    LT -> paddle2 -= paddleSpeed * time-    _  -> return ()--  -- Make sure both paddles don't leave the playing area-  paddle1 %= clamp-  paddle2 %= clamp-- where-   clamp = clampPad (paddleHeight/2)-   isIn  = member-   infixl 7 `isIn`---- Clamp to the region (-1, 1) but with padding-clampPad :: Float -> Float -> Float-clampPad 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 >= top) $-    ballSpeed._y %= negate--  -- Check for collisions with paddles-  let check l = y >= p^.l - paddleHeight/2 && y <= p^.l + paddleHeight/2--  let { collide = do-    ballSpeed._x   %= negate-    ballSpeed.both *= speedIncrease-  }--  when (x <= left) $-    if check paddle1-      then collide-      else score._2 += 1 >> reset--  when (x >= right) $-    if check paddle2-      then collide-      else score._1 += 1 >> reset--  where-    top   = 1 - ballRadius-    left  = ballRadius + paddleWidth/2 - 1-    right = -left---- Reset the game-reset :: State Pong ()-reset = do-  ballPos   ^= initial^.ballPos-  ballSpeed ^= initial^.ballSpeed---- Drawing a pong state to the screen--draw :: Pong -> Picture-draw p = scale gameSize gameSize $ Pictures-  [ drawBall   `at` p^.ballPos-  , drawPaddle `at` (-1, p^.paddle1)-  , drawPaddle `at` ( 1, p^.paddle2)--  -- Score and playing field-  , scale textSize textSize (p^.score.pretty.to text) `at` (-0.1, 0.85)-  , rectangleWire 2 2-  ]-  where-    -- Pretty printing lens-    pretty = to (\(x,y) -> show x ++ " " ++ show y)-    p `at` (x,y) = translate x y p-    infixr 1 `at`--drawPaddle :: Picture-drawPaddle = rectangleSolid paddleWidth paddleHeight--drawBall :: Picture-drawBall = circleSolid ballRadius---- Handle input by simply updating the keys set--handle :: Event -> Pong -> Pong-handle (EventKey k Down _ _) = keys %~ insert k-handle (EventKey k Up   _ _) = keys %~ delete k-handle _ = id---- The main program action--main = play display backColor fps initial draw handle update-  where-    -- display   = InWindow "Pong!" (windowSize, windowSize) (200, 200)-    display = FullScreen (800,600)-    backColor = white-    fps       = 120
lens.cabal view
@@ -1,8 +1,8 @@ name:          lens category:      Data, Lenses-version:       1.4.1+version:       1.5 license:       BSD3-cabal-version: >= 1.6+cabal-version: >= 1.8 license-file:  LICENSE author:        Edward A. Kmett maintainer:    Edward A. Kmett <ekmett@gmail.com>@@ -13,115 +13,11 @@ synopsis:      Lenses, Folds and Traversals description:   The combinators in @Control.Lens@ provide a highly generic toolbox for composing-  families of getters, folds, traversals, setters and lenses.-  .-  /Getter/-  .-  A @'Getter' a c@ is just any function @(a -> c)@, which we've flipped into continuation-  passing style, @(c -> r) -> a -> r@ and decorated with 'Const' to obtain-  .-  > type Getting r a b c d = (c -> Const r d) -> a -> Const r b-  .-  If we restrict access to knowledge about the type 'r' and can work for any d and b, we get:-  .-  > type Getter a c = forall r b d. Getting r a b c d-  .-  Everything you can do with a function, you can do with a 'Getter', but note that because of the-  continuation passing style (.) composes them in the opposite order.-  .-  Since it is only a function, every 'Getter' obviously only retrieves a single value for a given-  input.-  .-  /Fold/-  .-  A @'Fold' a c@ is a generalization of something 'Foldable'. It allows you to-  extract multiple results from a container. A 'Foldable' container can be-  characterized by the behavior of @foldMap :: (Foldable t, Monoid m) => (c -> m) -> t c -> m@.-  Since we want to be able to work with monomorphic containers, we generalize this signature to-  @forall m. 'Monoid' m => (c -> m) -> a -> m@, and then decorate it with 'Const' to obtain-  .-  > type Fold a c = forall m b d. Monoid m => Getting m a b c d-  .-  Every 'Getter' is a valid 'Fold' that simply doesn't use the 'Monoid' it is passed.-  .-  Everything you can do with a 'Foldable' container, you can with with a 'Fold' and there are-  combinators that generalize the usual 'Foldable' operations in @Control.Lens@.-  .-  /Traversal/-  .-  A @'Traversal' a b c d@ is a generalization of 'traverse' from 'Traversable'. It allows-  you to traverse over a structure and change out its contents with monadic or-  applicative side-effects. Starting from-  @'traverse' :: ('Traversable' t, 'Applicative' f) => (c -> f d) -> t c -> f (t d)@,-  we monomorphize the contents and result to obtain-  .-  > type Traversal a b c d = forall f. Applicative f => (c -> f d) -> a -> f b-  .-  While a 'Traversal' isn't quite a 'Fold', it _can_ be used for 'Getting' like a 'Fold', because -  given a 'Monoid' @m@, we have an 'Applicative' for @('Const' m)@.-  .-  Everything you can do with a 'Traversable' container, you can with with a 'Traversal', and there-  are combinators that generalize the usual 'Traversable' operations in @Control.Lens@.-  .-  /Setter/-  .-  A @'Setter' a b c d@ is a generalization of 'fmap' from 'Functor'. It allows you to map into a-  structure and change out the contents, but it isn't strong enough to allow you to-  enumerate those contents. Starting with @fmap :: 'Functor' f => (c -> d) -> f c -> f d@-  we monomorphize the type to obtain @(c -> d) -> a -> b@ and then decorate it with 'Identity' to obtain-  .-  > type Setter a b c d = (c -> Identity d) -> a -> Identity b-  .-  Every 'Traversal' is a valid 'Setter', since 'Identity' is 'Applicative'.-  .-  Everything you can do with a 'Functor', you can do with a 'Setter', and there are combinators that-  generalize the usual 'Functor' operations in @Control.Lens@.-  .-  /Lens/-  .-  A @'Lens' a b c d@ is a purely functional reference.-  .-  While a 'Traversal' could be used for 'Getting' like a valid 'Fold', it wasn't a valid 'Getter'.-  To make the 'Applicative' for 'Const' it required a 'Monoid' for the argument we passed it, which-  a 'Getter' doesn't recieve.-  .-  However, the instance of 'Functor' for 'Const' requires no such thing. If we weaken the type-  requirement from 'Applicative' to 'Functor' for 'Traversal', we obtain -  .-  > type Lens a b c d = forall f. Functor f => (c -> f d) -> a -> f b-  .-  Every 'Lens' is a valid 'Setter', choosing @f@ = 'Identity'.-  .-  Every 'Lens' can be used for 'Getting' like a 'Fold' that doesn't use the 'Monoid' it is passed.-  .-  Every 'Lens' is a valid 'Traversal' that only uses the 'Functor' part of the 'Applicative' it is supplied.-  .-  Every 'Lens' can be used for 'Getting' like a valid 'Getter', choosing @f@ = 'Const' @r@ for an appropriate @r@-  .-  Since every 'Lens' can be used for 'Getting' like a valid 'Getter' it follows that it must view exactly one-  element in the structure.-  .-  The lens laws follow from this property and the desire for it to act like a 'Functor' when used as a 'Setter'.-  .-  /Isomorphisms and Iso/-  .-  Control.Isomorphic provides easy overloading of function application for isomorphisms and @Iso a b c d@ uses it-  to form isomorphism families that can be composed with other isomorphisms and with lenses, setters, folds,-  traversals and getters.-  .-  > type Iso a b c d = forall k f. (Isomorphic k, Functor f) => k (c -> f d) (a -> f b)-  .-  /Composition/-  .-  Note that all of these types are type aliases, and you can compose these lenses with mere function compositon.-  .-  This is a generalization of the well-known trick for @(.).(.)@ or @fmap.fmap@, and their less well-known cousins-  @foldMap.foldMap@ @traverse.traverse@. It follows because each one is a function between values of type @(x -> f y)@-  and the composition takes the intersection of supplied functionality for you automatically!+  families of getters, folds, isomorphisms, traversals, setters and lenses and their indexed variants.   .   /Lens Families/   .-  For a longer description of why you should care about lenses, and an overview of why we use 4+  For a longer description of why you should care about lens families, and an overview of why we use 4   parameters a, b, c, and d instead of just 2, see <http://comonad.com/reader/2012/mirrored-lenses/>.   .   Sometimes you won't need the flexibility those extra parameters afford you and you can use@@ -142,13 +38,13 @@   .   /Deriving Lenses/   .-  You can derive lenses automatically for many data types using 'Control.Lens.TH', and if a-  container is fully characterized by its lenses, you can use 'Control.Lens.Representable' to-  automatically derive 'Functor', 'Applicative', 'Monad', and 'Derivable'.+  You can derive lenses automatically for many data types using 'makeLenses', and if a+  container is fully characterized by its lenses, you can use 'Representable' to+  automatically derive 'Functor', 'Applicative', 'Monad', and 'Distributive'.  build-type:    Simple tested-with:   GHC == 7.4.1-extra-source-files: .travis.yml examples/Pong.hs examples/Test.hs examples/Pong2.hs+extra-source-files: .travis.yml examples/Pong.hs examples/Test.hs  source-repository head   type: git@@ -156,36 +52,37 @@  library   build-depends:-    base         >= 4.3   && < 5,-    containers   >= 0.4.2 && < 0.6,-    mtl          >= 2.0.1 && < 2.2,-    transformers >= 0.2.2 && < 0.4+    base             >= 4.3   && < 5,+    containers       >= 0.4.2 && < 0.6,+    mtl              >= 2.0.1 && < 2.2,+    template-haskell >= 2.4   && < 2.8,+    transformers     >= 0.3   && < 0.4 -  exposed-modules: Control.Indexed-                   Control.Isomorphic+  exposed-modules: Control.Exception.Lens                    Control.Lens                    Control.Lens.Internal                    Control.Lens.Representable-  -- base-  exposed-modules: Control.Exception.Lens+                   Control.Lens.Fold+                   Control.Lens.Getter+                   Control.Lens.Indexed+                   Control.Lens.Iso+                   Control.Lens.Setter+                   Control.Lens.TH+                   Control.Lens.Traversal+                   Control.Lens.Type                    Data.Bits.Lens                    Data.Complex.Lens                    Data.Dynamic.Lens                    Data.Either.Lens                    Data.List.Lens                    Data.Pair.Lens--  -- containers-  exposed-modules: Data.IntMap.Lens+                   Data.IntMap.Lens                    Data.IntSet.Lens                    Data.Map.Lens                    Data.Sequence.Lens                    Data.Set.Lens                    Data.Tree.Lens--  build-depends:   template-haskell >= 2.4 && < 2.8-  exposed-modules: Language.Haskell.TH.Lens-                   Control.Lens.TH+                   Language.Haskell.TH.Lens    -- platform   build-depends:   array >= 0.3.0.2 && < 0.5@@ -201,10 +98,12 @@   exposed-modules: Control.Parallel.Strategies.Lens Control.Seq.Lens    other-extensions:+    BangPatterns     CPP     DeriveDataTypeable     FlexibleContexts     FlexibleInstances+    FunctionalDependencies     LiberalTypeSynonyms     MultiParamTypeClasses     Rank2Types@@ -212,6 +111,7 @@     TemplateHaskell     TypeFamilies     TypeOperators+    UndecidableInstances    if (impl(ghc>=7.4))     other-extensions: Trustworthy@@ -220,3 +120,13 @@    ghc-options: -Wall -fwarn-tabs -O2 -fdicts-cheap -funbox-strict-fields   hs-source-dirs: src++test-suite doctests+  type:            exitcode-stdio-1.0+  main-is:         doctests.hs++  build-depends:   base == 4.*,+                   doctest >= 0.8 && <= 0.9++  ghc-options:     -Wall -Werror -threaded+  hs-source-dirs:  test
− src/Control/Indexed.hs 
@@ -1,70 +0,0 @@-{-# LANGUAGE Rank2Types #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE FlexibleContexts #-}--------------------------------------------------------------------------------- |--- Module      :  Control.Indexed--- Copyright   :  (C) 2012 Edward Kmett--- License     :  BSD-style (see the file LICENSE)--- Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  provisional--- Portability :  rank 2 types, MPTCs, TFs, flexible---------------------------------------------------------------------------------module Control.Indexed-  (-  -- * Overloading indexed functions-    Indexed(..)-  , Indexable-  , Index(..)-  , (.@)-  , composeWithIndex-  , reindex-  ) where---- | Permit overloading of function application for things that also admit a notion of a key or index.---- | Provides overloading for indexed functions.-class Indexed i k where-  -- | Build a function from an indexed function-  index :: ((i -> a) -> b) -> k a b---- | Type alias for passing around polymorphic indexed functions.-type Indexable i a b = forall k. Indexed i k => k a b--instance Indexed i (->) where-  index f = f . const-  {-# INLINE index #-}---- | A function with access to a index. This constructor may be useful when you need to store--- a 'HasIndex'.-newtype Index i a b = Index { withIndex :: (i -> a) -> b }---- | Using an equality witness to avoid potential overlapping instances--- and aid dispatch.-instance i ~ j => Indexed i (Index j) where-  index = Index-  {-# INLINE index #-}---- | Remap the index.-reindex :: Indexed j k => (i -> j) -> Index i a b -> k a b-reindex ij (Index iab) = index $ \ ja -> iab $ \i -> ja (ij i)-{-# SPECIALIZE reindex :: (i -> j) -> Index i a b -> Index j a b #-}-{-# SPECIALIZE reindex :: (i -> j) -> Index i a b -> a -> b #-}--infixr 9 .@--- | Composition of indexed functions-(.@) :: Indexed (i, j) k => Index i b c -> Index j a b -> k a c-f .@ g = composeWithIndex (,) f g-{-# INLINE (.@) #-}-{-# SPECIALIZE (.@) :: Index i b c -> Index j a b -> Index (i,j) a c #-}-{-# SPECIALIZE (.@) :: Index i b c -> Index j a b -> a -> c #-}---- | Composition of indexed functions with a user supplied function for combining indexs-composeWithIndex :: Indexed k r => (i -> j -> k) -> Index i b c -> Index j a b -> r a c-composeWithIndex ijk (Index ibc) (Index jab) = index $ \ka -> ibc $ \i -> jab $ \j -> ka (ijk i j)-{-# INLINE composeWithIndex #-}-{-# SPECIALIZE composeWithIndex :: (i -> j -> k) -> Index i b c -> Index j a b -> a -> c #-}-
− src/Control/Isomorphic.hs 
@@ -1,100 +0,0 @@-{-# LANGUAGE Rank2Types #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE TypeOperators #-}--------------------------------------------------------------------------------- |--- Module      :  Control.Isomorphic--- Copyright   :  (C) 2012 Edward Kmett--- License     :  BSD-style (see the file LICENSE)--- Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  provisional--- Portability :  rank 2 types---------------------------------------------------------------------------------module Control.Isomorphic-  ( Isomorphic(..)-  , Isomorphism(..)-  , from-  , via-  , (:~>)-  ) where--import Control.Category-import Prelude hiding ((.),id)-import Data.Typeable--------------------------------------------------------------------------------- Isomorphism Implementation Details---------------------------------------------------------------------------------- | An isomorphism from a to b, overloaded to permit its use directly as a function.------ You can use a value of type @(a :~ b)@ as if it were @(a -> b)@ or @Isomorphism a b@.-infixr 0 :~>-type a :~> b = forall k. Isomorphic k => k a b---- | Used to provide overloading of isomorphism application------ This is a 'Category' with a canonical mapping to it from the--- category of isomorphisms over Haskell types.-class Category k => Isomorphic k where-  -- | Build this morphism out of an isomorphism-  ---  -- The intention is that by using 'isomorphic', you can supply both halves of an-  -- isomorphism, but k can be instantiated to (->), so you can freely use-  -- the resulting isomorphism as a function.-  isomorphic :: (a -> b) -> (b -> a) -> k a b--  -- | Map a morphism in the target category using an isomorphism between morphisms-  -- in Hask.-  isomap :: ((a -> b) -> c -> d) -> ((b -> a) -> d -> c) -> k a b -> k c d--instance Isomorphic (->) where-  isomorphic = const-  {-# INLINE isomorphic #-}-  isomap = const-  {-# INLINE isomap #-}---- | A concrete data type for isomorphisms.------ This lets you place an isomorphism inside a container without using @ImpredicativeTypes@.-data Isomorphism a b = Isomorphism (a -> b) (b -> a)-  deriving (Typeable)--instance Category Isomorphism where-  id = Isomorphism id id-  {-# INLINE id #-}-  Isomorphism bc cb . Isomorphism ab ba = Isomorphism (bc . ab) (ba . cb)-  {-# INLINE (.) #-}--instance Isomorphic Isomorphism where-  isomorphic = Isomorphism-  {-# INLINE isomorphic #-}-  isomap abcd badc (Isomorphism ab ba) = Isomorphism (abcd ab) (badc ba)-  {-# INLINE isomap #-}---- | Invert an isomorphism.------ Note to compose an isomorphism and receive an isomorphism in turn you'll need to use--- 'Control.Category.Category'------ > from (from l) = l------ If you imported 'Control.Category.(.)', then:------ > from l . from r = from (r . l)------ > from :: (a :~> b) -> (b :~> a)-from :: Isomorphic k => Isomorphism a b -> k b a-from (Isomorphism a b) = isomorphic b a-{-# INLINE from #-}-{-# SPECIALIZE from :: Isomorphism a b -> b -> a #-}-{-# SPECIALIZE from :: Isomorphism a b -> Isomorphism b a #-}---- |--- > via :: Isomorphism a b -> (a :~> b)-via :: Isomorphic k => Isomorphism a b -> k a b-via (Isomorphism a b) = isomorphic a b-{-# INLINE via #-}-{-# SPECIALIZE via :: Isomorphism a b -> a -> b #-}-{-# SPECIALIZE via :: Isomorphism a b -> Isomorphism a b #-}
src/Control/Lens.hs view
@@ -33,1937 +33,37 @@ -- -- You can derive lenses automatically for many data types: ----- > import Control.Lens.TH--- > data Foo a = Foo { _fooArgs :: [String], _fooValue :: a }--- > makeLenses ''Foo------ This defines the following lenses:------ > fooArgs :: Simple Lens (Foo a) [String]--- > fooValue :: Lens (Foo a) (Foo b) a b------ The combinators here have unusually specific type signatures, so for--- particularly tricky ones, I've tried to list the simpler type signatures--- you might want to pretend the combinators have.---------------------------------------------------------------------------------module Control.Lens-  (-  -- * Lenses-    Lens-  , LensLike-  , Traversal-  , Simple-  , SimpleLens-  , SimpleTraversal-  , SimpleLensLike-  , (%%~), (%%=)-  , lens--  -- ** Common Lenses-  , _1, _2-  , resultAt-  , element-  , elementOf--  -- * Isomorphisms-  , Iso-  , SimpleIso-  , Overloaded-  , SimpleOverloaded-  , iso-  , isos-  , Isomorphic(..)-  , from--  -- * Setters-  , Setter-  , SimpleSetter-  , sets-  , mapped-  , adjust, mapOf-  , set-  , whisper-  , (^~), (%~), (<~)-  , (^=), (%=)--  -- * Getters and Folds-  , Getter-  , Fold-  , Getting-  , to-  , folds-  , folding-  , folded-  , unfolded-  , iterated-  , filtered-  , reversed-  , repeated-  , replicated-  , cycled-  , takingWhile-  , droppingWhile-  , view, views-  , (^.), (^$)-  , use, uses-  , query, queries--  -- ** Getting and Folding-  , foldMapOf, foldOf-  , foldrOf, foldlOf-  , toListOf-  , anyOf, allOf-  , andOf, orOf-  , productOf, sumOf-  , traverseOf_, forOf_, sequenceAOf_-  , mapMOf_, forMOf_, sequenceOf_-  , asumOf, msumOf-  , concatMapOf, concatOf-  , elemOf, notElemOf-  , lengthOf-  , nullOf-  , headOf, lastOf-  , maximumOf, minimumOf-  , maximumByOf, minimumByOf-  , findOf-  , foldrOf', foldlOf'-  , foldr1Of, foldl1Of-  , foldrMOf, foldlMOf--  -- * Setting-  , (+~), (-~), (*~), (//~), (||~), (&&~), (<>~)-  , (+=), (-=), (*=), (//=), (||=), (&&=), (<>=)--  -- * Traversing and Lensing-  , Focus(..)-  , traverseOf, forOf, sequenceAOf-  , mapMOf, forMOf, sequenceOf-  , transposeOf-  , mapAccumLOf, mapAccumROf-  , scanr1Of, scanl1Of--  -- * Common Traversals-  , Traversable(traverse)-  , traverseNothing--  -- * Transforming Traversals-  , backwards--  -- * Cloning Lenses-  , clone-  , merged-  , bothLenses--  -- ** Common Isomorphisms-  , identity-  , konst--  -- * Indexed Folds-  , Index(..)-  , Indexed(..)-  , IndexedFold-  , foldMapWithIndexOf-  , foldrWithIndexOf--  -- * Indexed Traversals-  , IndexedTraversal-  , SimpleIndexedTraversal-  , traverseWithIndexOf-  , mapMWithIndexOf-  ) where--import Control.Applicative              as Applicative-import Control.Applicative.Backwards-import Control.Category-import Control.Indexed-import Control.Isomorphic-import Control.Lens.Internal-import Control.Monad-import Control.Monad.Reader.Class       as Reader-import Control.Monad.State.Class        as State-import Control.Monad.Trans.State.Lazy   as Lazy-import Control.Monad.Trans.State.Strict as Strict-import Control.Monad.Trans.Reader-import Control.Monad.Writer.Class       as Writer-import Data.Foldable                    as Foldable-import Data.Functor.Identity-import Data.Maybe-import Data.Monoid-import Data.Traversable-import Prelude hiding ((.),id)--infixl 8 ^.-infixr 4 ^~, +~, *~, -~, //~, &&~, ||~, %~, <>~, %%~, <~-infix  4 ^=, +=, *=, -=, //=, &&=, ||=, %=, <>=, %%=-infixr 0 ^$--------------------------------- Lenses------------------------------- | A 'Lens' is actually a lens family as described in <http://comonad.com/reader/2012/mirrored-lenses/>.------ With great power comes great responsibility and a 'Lens' is subject to the three common sense lens laws:------ 1) You get back what you put in:------ > view l (set l b a)  = b------ 2) Putting back what you got doesn't change anything:------ > set l (view l a) a  = a------ 3) Setting twice is the same as setting once:------ > set l c (set l b a) = set l c a------ These laws are strong enough that the 4 type parameters of a 'Lens' cannot vary fully independently. For more on--- how they interact, read the "Why is it a Lens Family?" section of <http://comonad.com/reader/2012/mirrored-lenses/>.------ Every 'Lens' can be used directly as a 'Setter' or 'Traversal'.------ You can also use a 'Lens' for 'Getting' as if it were a 'Fold' or 'Getter'.------ Since every lens is a valid 'Traversal', the traversal laws should also apply to any lenses you create.------ 1.) Idiomatic naturality:------ > l pure = pure------ 2.) Sequential composition:------ > fmap (l f) . l g = getCompose . l (Compose . fmap f . g)------ > type Lens = forall f. Functor f => LensLike f a b c d-type Lens a b c d = forall f. Functor f => (c -> f d) -> a -> f b----------------------------------------------------------------------------------- Traversals----------------------------------------------------------------------------------- | A 'Traversal' can be used directly as a 'Setter' or a 'Fold' (but not as a 'Lens') and provides--- the ability to both read and update multiple fields, subject to some relatively weak 'Traversal' laws.------ These have also been known as multilenses, but they have the signature and spirit of------ > traverse :: Traversable f => Traversal (f a) (f b) a b------ and the more evocative name suggests their application.------ Most of the time the 'Traversal' you will want to use is just 'traverse', but you can also pass any--- 'Lens' or 'Iso' as a Traversal, and composition of a 'Traversal' (or 'Lens' or 'Iso') with a 'Traversal' (or 'Lens' or 'Iso')--- using (.) forms a valid 'Traversal'.------ The laws for a Traversal @t@ follow from the laws for Traversable as stated in \"The Essence of the Iterator Pattern\".------ 1) Idiomatic naturality:------ > t pure = pure------ 2) Sequential composition:------ > fmap (t f) . t g = getCompose . t (Compose . fmap f . g)------ One consequence of this requirement is that a traversal needs to leave the same number of elements as a candidate for --- subsequent traversal as it started with.------ 3) No duplication of elements (as defined in \"The Essence of the Iterator Pattern\" section 5.5), which states--- that you should incur no effect caused by visiting the same element of the container twice.-type Traversal a b c d = forall f. Applicative f => (c -> f d) -> a -> f b---- | A @'Simple' 'Lens'@, @'Simple' 'Traversal'@, ... can be used instead of a 'Lens','Traversal', ...--- whenever the type variables don't change upon setting a value.------ > imaginary :: Simple Lens (Complex a) a--- > traverseHead :: Simple Traversal [a] a------ Note: To use this alias in your own code with @'LensLike' f@ or @Setter@, you may have to turn on--- @LiberalTypeSynonyms@.-type Simple f a b = f a a b b---- | > type SimpleTraversal = Simple Traversal-type SimpleTraversal a b = Traversal a a b b---- | > type SimpleLens = Simple Lens-type SimpleLens a b = Lens a a b b---- | > type SimpleLensLike f = Simple (LensLike f)-type SimpleLensLike f a b = LensLike f a a b b------------------------------- Constructing Lenses------------------------------- | Build a 'Lens' from a getter and a setter.------ > lens :: Functor f => (a -> c) -> (a -> d -> b) -> (c -> f d) -> a -> f b-lens :: (a -> c) -> (a -> d -> b) -> Lens a b c d-lens ac adb cfd a = adb a <$> cfd (ac a)-{-# INLINE lens #-}------------------------------- LensLike------------------------------- |--- Many combinators that accept a 'Lens' can also accept a 'Traversal' in limited situations.------ They do so by specializing the type of 'Functor' that they require of the caller.------ If a function accepts a @'LensLike' f a b c d@ for some 'Functor' @f@, then they may be passed a 'Lens'.------ Further, if @f@ is an 'Applicative', they may also be passed a 'Traversal'.-type LensLike f a b c d = (c -> f d) -> a -> f b---- | ('%%~') can be used in one of two scenarios:------ When applied to a 'Lens', it can edit the target of the 'Lens' in a structure, extracting a--- functorial result.------ When applied to a 'Traversal', it can edit the targets of the 'Traversals', extracting an--- applicative summary of its actions.------ For all that the definition of this combinator is just:------ > (%%~) = id------ > (%%~) :: Functor f =>     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 => 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 restrictive types, however:------ When applied to a 'Traversal', it can edit the targets of the 'Traversals', extracting a--- supplemental monoidal summary of its actions, by choosing f = ((,) m)------ > (%%~) ::             Iso a b c d       -> (c -> (e, d)) -> a -> (e, b)--- > (%%~) ::             Lens a b c d      -> (c -> (e, d)) -> a -> (e, b)--- > (%%~) :: Monoid m => Traversal a b c d -> (c -> (m, d)) -> a -> (m, b)-(%%~) :: LensLike f a b c d -> (c -> f d) -> a -> f b-(%%~) = id-{-# INLINE (%%~) #-}---- | Modify the target of a 'Lens' in the current state returning some extra information of @c@ or--- modify all targets of a 'Traversal' in the current state, extracting extra information of type @c@--- and return a monoidal summary of the changes.------ > (%%=) = (state.)------ It may be useful to think of ('%%='), instead, as having either of the following more restricted--- type signatures:------ > (%%=) :: MonadState a m             => 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) => 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)-l %%= f = State.state (l f)-#else-l %%= f = do-  (e, b) <- State.gets (l f)-  State.put b-  return e-#endif-{-# INLINE (%%=) #-}---- | This class allows us to use 'focus' on a number of different monad transformers.-class Focus st where-  -- | Run a monadic action in a larger context than it was defined in, using a 'Simple' 'Lens' or 'Simple' 'Traversal'.-  ---  -- This is commonly used to lift actions in a simpler state monad into a state monad with a larger state type.-  ---  -- When applied to a 'Simple 'Traversal' over multiple values, the actions for each target are executed sequentially-  -- and the results are aggregated monoidally-  -- and a monoidal summary-  -- of the result is given.-  ---  -- > focus :: Monad m             => Simple Iso a b       -> st b m c -> st a m c-  -- > focus :: Monad m             => Simple Lens a b      -> st b m c -> st a m c-  -- > focus :: (Monad m, Monoid c) => Simple Traversal a b -> st b m c -> st a m c-  focus :: Monad m => LensLike (Focusing m c) a a b b -> st b m c -> st a m c--  -- | Like 'focus', but discarding any accumulated results as you go.-  ---  -- > focus_ :: Monad m             => Simple Iso a b       -> st b m c -> st a m ()-  -- > focus_ :: Monad m             => Simple Lens a b      -> st b m c -> st a m ()-  -- > focus_ :: (Monad m, Monoid c) => Simple Traversal a b -> st b m c -> st a m ()-  focus_ :: Monad m => LensLike (Focusing m ()) a a b b -> st b m c -> st a m ()--  -- | A much more limited version of 'focus' that can work with a 'Setter'.-  setFocus :: Simple Setter a b -> st b Identity c -> st a Identity ()--skip :: a -> ()-skip _ = ()-{-# INLINE skip #-}--instance Focus Strict.StateT where-  focus l m = Strict.StateT $ unfocusing . l (Focusing . Strict.runStateT m)-  {-# INLINE focus #-}-  focus_ l m = Strict.StateT $ unfocusing . l (Focusing . Strict.runStateT (liftM skip m))-  {-# INLINE focus_ #-}-  setFocus l m = Strict.state $ (,) () . runIdentity . l (Identity . snd . Strict.runState m)--instance Focus Lazy.StateT where-  focus l m = Lazy.StateT $ unfocusing . l (Focusing . Lazy.runStateT m)-  {-# INLINE focus #-}-  focus_ l m = Lazy.StateT $ unfocusing . l (Focusing . Lazy.runStateT (liftM skip m))-  {-# INLINE focus_ #-}-  setFocus l m = Lazy.state $ (,) () . runIdentity . l (Identity . snd . Lazy.runState m)--instance Focus ReaderT where-  --focus l m = ReaderT $ \a -> liftM fst $ unfocusing $ l (\b -> Focusing $ (\c -> (c,b)) `liftM` runReaderT m b) a-  focus l m = ReaderT $ liftM fst . unfocusing . l (\b -> Focusing $ (\c -> (c,b)) `liftM` runReaderT m b)-  {-# INLINE focus #-}-  focus_ l m = ReaderT $ \a -> liftM skip $ unfocusing $ l (\b -> Focusing $ (\_ -> ((),b)) `liftM` runReaderT m b) a-  {-# INLINE focus_ #-}-  setFocus _ _ = return () -- BOOORING------------------------------- Traversal Combinators------------------------------- |--- Map each element of a structure targeted by a Lens or Traversal,--- evaluate these actions from left to right, and collect the results.------ > traverseOf = id------ > traverse = traverseOf traverse------ > traverseOf :: Iso a b c d       -> (c -> f d) -> a -> f b--- > traverseOf :: Lens a b c d      -> (c -> f d) -> a -> f b--- > traverseOf :: Traversal a b c d -> (c -> f d) -> a -> f b-traverseOf :: Category k => k (LensLike f a b c d) ((c -> f d) -> a -> f b)-traverseOf = id-{-# INLINE traverseOf #-}-{-# SPECIALIZE traverseOf :: LensLike f a b c d -> (c -> f d) -> a -> f b #-}---- |------ > forOf l = flip (traverseOf l)------ > for = forOf traverse--- > forOf = morphism flip flip------ > forOf :: Lens a b c d -> a -> (c -> f d) -> f b-forOf :: Isomorphic k => k (LensLike f a b c d) (a -> (c -> f d) -> f b)-forOf = isomorphic flip flip-{-# INLINE forOf #-}-{-# SPECIALIZE forOf :: LensLike f a b c d -> a -> (c -> f d) -> f b #-}---- |--- Evaluate each action in the structure from left to right, and collect--- the results.------ > sequenceA = sequenceAOf traverse--- > sequenceAOf l = traverseOf l id--- > sequenceAOf l = l id------ > sequenceAOf ::                  Iso a b (f c) c       -> a -> f b--- > sequenceAOf ::                  Lens a b (f c) c      -> a -> f b--- > sequenceAOf :: Applicative f => Traversal a b (f c) c -> a -> f b-sequenceAOf :: LensLike f a b (f c) c -> a -> f b-sequenceAOf l = l id-{-# INLINE sequenceAOf #-}---- | Map each element of a structure targeted by a lens to a monadic action,--- evaluate these actions from left to right, and collect the results.------ > mapM = mapMOf traverse------ > mapMOf ::            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)-{-# INLINE mapMOf #-}---- |--- > forM = forMOf traverse--- > forMOf l = flip (mapMOf l)------ > forMOf ::            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)-{-# INLINE forMOf #-}---- |--- > sequence = sequenceOf traverse--- > sequenceOf l = mapMOf l id--- > sequenceOf l = unwrapMonad . l WrapMonad------ > sequenceOf ::            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-{-# INLINE sequenceOf #-}---- | This generalizes 'Data.List.transpose' to an arbitrary 'Traversal'.------ > transpose = transposeOf traverse------ > ghci> transposeOf traverse [[1,2,3],[4,5,6]]--- > [[1,4],[2,5],[3,6]]------ Since every 'Lens' is a Traversal, we can use this as a form of--- monadic strength.------ > transposeOf _2 :: (b, [a]) -> [(b, a)]-transposeOf :: LensLike ZipList a b [c] c -> a -> [b]-transposeOf l = getZipList . l ZipList-{-# INLINE transposeOf #-}---- | Generalizes 'Data.Traversable.mapAccumR' to an arbitrary 'Traversal'.------ > mapAccumR = mapAccumROf traverse------ 'mapAccumROf' accumulates state from right to left.------ > mapAccumROf :: 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)-{-# INLINE mapAccumROf #-}---- | Generalized 'Data.Traversable.mapAccumL' to an arbitrary 'Traversal'.------ > mapAccumL = mapAccumLOf traverse------ 'mapAccumLOf' accumulates state from left to right.------ > mapAccumLOf :: 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 l = mapAccumROf (backwards l)-{-# INLINE mapAccumLOf #-}--swap :: (a,b) -> (b,a)-swap (a,b) = (b,a)-{-# INLINE swap #-}---- | Permit the use of 'scanr1' over an arbitrary 'Traversal' or 'Lens'.------ > scanr1 = scanr1Of 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 :: LensLike (Lazy.State (Maybe c)) a b c c -> (c -> c -> c) -> a -> b-scanr1Of l f = snd . mapAccumROf l step Nothing where-  step Nothing c  = (Just c, c)-  step (Just s) c = (Just r, r) where r = f c s-{-# INLINE scanr1Of #-}---- | Permit the use of 'scanl1' over an arbitrary 'Traversal' or 'Lens'.------ > 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-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-  step Nothing c  = (Just c, c)-  step (Just s) c = (Just r, r) where r = f s c-{-# INLINE scanl1Of #-}----------------------------------------------------------------------------------- Setters----------------------------------------------------------------------------------- |--- The only 'Lens'-like law that can apply to a 'Setter' @l@ is that------ > set l c (set l b a) = set l c a------ You can't 'view' a 'Setter' in general, so the other two laws are irrelevant.------ However, two functor laws apply to a 'Setter'------ > adjust l id = id--- > adjust l f . adjust l g = adjust l (f . g)------ These an be stated more directly:------ > l Identity = Identity--- > l f . runIdentity . l g = l (f . runIdentity . g)------ You can compose a 'Setter' with a 'Lens' or a 'Traversal' using @(.)@ from the Prelude--- and the result is always only a 'Setter' and nothing more.------ > type Setter a b c d = LensLike Identity a b c d-type Setter a b c d = (c -> Identity d) -> a -> Identity b---- | This alias is supplied for those who don't want to use @LiberalTypeSynonyms@ with--- 'Simple'.------ > 'SimpleSetter ' = 'Simple' 'Setter'-type SimpleSetter a b = Setter a a b b---- | This setter can be used to map over all of the values in a 'Functor'.------ > fmap        = adjust mapped--- > fmapDefault = adjust traverse--- > (<$)        = set mapped-mapped :: Functor f => Setter (f a) (f b) a b-mapped = sets fmap-{-# INLINE mapped #-}---- | Build a Setter.------ > sets . adjust = id--- > adjust . sets = id--- > sets = from adjust--- > adjust = from sets------ > sets :: ((c -> d) -> a -> b) -> Setter a b c d-sets :: Isomorphic k => k ((c -> d) -> a -> b) (Setter a b c d)-sets = isomorphic (\f g -> Identity . f (runIdentity . g))-                  (\l f -> runIdentity . l (Identity . f))-{-# INLINE sets #-}-{-# SPECIALIZE sets :: ((c -> d) -> a -> b) -> Setter a b c d #-}---- | Modify the target of a 'Lens' or all the targets of a 'Setter' or 'Traversal'--- with a function.------ > fmap        = adjust mapped--- > fmapDefault = adjust traverse------ > sets . adjust = id--- > adjust . sets = id------ > adjust :: Setter a b c d -> (c -> d) -> a -> b-adjust :: Isomorphic k => k (Setter a b c d) ((c -> d) -> a -> b)-adjust = isomorphic (\l f -> runIdentity . l (Identity . f))-                    (\f g -> Identity . f (runIdentity . g))-{-# INLINE adjust #-}-{-# SPECIALIZE adjust :: Setter a b c d -> (c -> d) -> a -> b #-}---- | Modify the target of a 'Lens' or all the targets of a 'Setter' or 'Traversal'--- with a function. This is an alias for adjust that is provided for consistency.------ > mapOf = adjust------ > fmap        = mapOf mapped--- > fmapDefault = mapOf traverse------ > sets . mapOf = id--- > mapOf . sets = id------ > mapOf :: Setter a b c d    -> (c -> d) -> a -> b--- > mapOf :: Iso a b c d       -> (c -> d) -> a -> b--- > mapOf :: Lens a b c d      -> (c -> d) -> a -> b--- > mapOf :: Traversal a b c d -> (c -> d) -> a -> b-mapOf :: Isomorphic k => k (Setter a b c d) ((c -> d) -> a -> b)-mapOf = adjust-{-# INLINE mapOf #-}-{-# SPECIALIZE mapOf :: Setter a b c d -> (c -> d) -> a -> b #-}---- | Replace the target of a 'Lens' or all of the targets of a 'Setter'--- or 'Traversal' with a constant value.------ > (<$) = set mapped------ > set :: Setter a b c d    -> d -> a -> b--- > set :: Iso a b c d       -> d -> a -> b--- > set :: Lens a b c d      -> d -> a -> b--- > set :: Traversal a b c d -> d -> a -> b-set :: Setter a b c d -> d -> a -> b-set l d = runIdentity . l (\_ -> Identity d)-{-# INLINE set #-}---- | Modifies the target of a 'Lens' or all of the targets of a 'Setter' or--- 'Traversal' with a user supplied function.------ This is an infix version of 'adjust'------ > fmap f = mapped %~ f--- > fmapDefault f = traverse %~ f------ > ghci> _2 %~ length $ (1,"hello")--- > (1,5)------ > (%~) :: Setter a b c d    -> (c -> d) -> a -> b--- > (%~) :: Iso a b c d       -> (c -> d) -> a -> b--- > (%~) :: Lens a b c d      -> (c -> d) -> a -> b--- > (%~) :: Traversal a b c d -> (c -> d) -> a -> b-(%~) :: Setter a b c d -> (c -> d) -> a -> b-(%~) = adjust-{-# INLINE (%~) #-}---- | Replace the target of a 'Lens' or all of the targets of a 'Setter'--- or 'Traversal' with a constant value.------ This is an infix version of 'set', provided for consistency with '(^=)'-(^~) :: Setter a b c d -> d -> a -> b-(^~) = set-{-# INLINE (^~) #-}---- | Replace the target of a 'Lens' or all of the targets of a 'Setter'--- or 'Traversal' with a constant value.------ This is an infix version of 'set'------ > f <$ a = mapped <~ f $ a------ > ghci> bitAt 0 <~ True $ 0--- > 1------ > (<~) :: Setter a b c d    -> d -> a -> b--- > (<~) :: Iso a b c d       -> d -> a -> b--- > (<~) :: Lens a b c d      -> d -> a -> b--- > (<~) :: Traversal a b c d -> d -> a -> b-(<~) :: Setter a b c d -> d -> a -> b-(<~) = set-{-# INLINE (<~) #-}---- | Increment the target(s) of a numerically valued 'Lens', Setter' or 'Traversal'------ > ghci> _1 +~ 1 $ (1,2)--- > (2,2)-(+~) :: Num c => Setter a b c c -> c -> a -> b-l +~ n = adjust l (+ n)-{-# INLINE (+~) #-}---- | Multiply the target(s) of a numerically valued 'Lens', 'Iso', 'Setter' or 'Traversal'------ > ghci> _2 *~ 4 $ (1,2)--- > (1,8)-(*~) :: Num c => Setter a b c c -> c -> a -> b-l *~ n = adjust l (* n)-{-# INLINE (*~) #-}---- | Decrement the target(s) of a numerically valued 'Lens', 'Iso', 'Setter' or 'Traversal'------ > ghci> _1 -~ 2 $ (1,2)--- > (-1,2)-(-~) :: Num c => Setter a b c c -> c -> a -> b-l -~ n = adjust l (subtract n)-{-# INLINE (-~) #-}---- | Divide the target(s) of a numerically valued 'Lens', 'Iso', 'Setter' or 'Traversal'-(//~) :: Fractional c => Setter a b c c -> c -> a -> b-l //~ n = adjust l (/ n)---- | Logically '||' the target(s) of a 'Bool'-valued 'Lens' or 'Setter'-(||~):: Setter a b Bool Bool -> Bool -> a -> b-l ||~ n = adjust l (|| n)-{-# INLINE (||~) #-}---- | Logically '&&' the target(s) of a 'Bool'-valued 'Lens' or 'Setter'-(&&~) :: Setter a b Bool Bool -> Bool -> a -> b-l &&~ n = adjust l (&& n)-{-# INLINE (&&~) #-}---- | Modify the target of a monoidally valued by 'mappend'ing another value.-(<>~) :: Monoid c => Setter a b c c -> c -> a -> b-l <>~ n = adjust l (mappend n)-{-# INLINE (<>~) #-}-------------------- Getters-------------------- | A 'Getter' describes how to retrieve a single value in a way that can be composed with--- other lens-like constructions.------ Unlike a 'Lens' a 'Getter' is read-only. Since a 'Getter' cannot be used to write back--- there are no lens laws that can be applied to it.------ Moreover, a 'Getter' can be used directly as a 'Fold', since it just ignores the 'Monoid'.------ In practice the @b@ and @d@ are left dangling and unused, and as such is no real point in--- using a @'Simple' 'Getter'@.------ > type Getter a c = forall r. LensLike (Const r) a b c d-type Getter a c = forall r b d. (c -> Const r d) -> a -> Const r b---- | Build a 'Getter' from an arbitrary Haskell function.------ > to f . to g = to (g . f)--- > to = from view------ > to . from = id-to :: (a -> c) -> Getter a c-to f g = Const . getConst . g . f-{-# INLINE to #-}---- |--- Most 'Getter' combinators are able to be used with both a 'Getter' or a 'Fold' in--- limited situations, to do so, they need to be monomorphic in what we are going to--- extract with 'Const'. To be compatible with 'Lens', 'Traversal' and 'Iso' we also--- restricted choices of the irrelevant b and d parameters.------ If a function accepts a @Getting r a b c d@, then when @r@ is a Monoid, you can--- pass a 'Fold' (or 'Traversal'), otherwise you can only pass this a 'Getter' or 'Lens'.------ > type Getting r a b c d = LensLike (Const r) a b c d-type Getting r a b c d = (c -> Const r d) -> a -> Const r b------------------------------------ Getting Values------------------------------------ | View the value pointed to by a 'Getter', 'Iso' or 'Lens' or the result of folding over--- all the results of a 'Fold' or 'Traversal' that points at a monoidal values.------ It may be useful to think of 'view' as having these more restrictive signatures:------ > view ::             Getter a c        -> a -> c--- > view :: Monoid m => Fold a m          -> a -> m--- > view ::             Iso a b c d       -> a -> c--- > view ::             Lens a b c d      -> a -> c--- > view :: Monoid m => Traversal a b m d -> a -> m-view :: Getting c a b c d -> a -> c-view l = getConst . l Const---- | View the value of a 'Getter', 'Iso', 'Lens' or the result of folding over the--- result of mapping the targets of a 'Fold' or 'Traversal'.------ It may be useful to think of 'views' as having these more restrictive signatures:------ > views ::             Getter a c        -> (c -> d) -> a -> d--- > views :: Monoid m => Fold a c          -> (c -> m) -> a -> m--- > views ::             Iso a b c d       -> (c -> d) -> a -> d--- > views ::             Lens a b c d      -> (c -> d) -> a -> d--- > views :: Monoid m => Traversal a b c d -> (c -> m) -> a -> m------ > views :: ((c -> Const m d) -> a -> Const m b) -> (c -> m) -> a -> m-views :: Isomorphic k => k (Getting m a b c d) ((c -> m) -> a -> m)-views = isomorphic (\l f -> getConst . l (Const . f)) (\l f -> Const . l (getConst . f))-{-# INLINE views #-}-{-# SPECIALIZE views :: Getting m a b c d -> (c -> m) -> a -> m #-}-{-# SPECIALIZE views :: Isomorphism (Getting m a b c d) ((c -> m) -> a -> m) #-}---- | View the value pointed to by a 'Getter', 'Iso' or 'Lens' or the result of folding over--- all the results of a 'Fold' or 'Traversal' that points at a monoidal values.------ This is the same operation as 'view', only infix.------ > (^$) ::             Getter a c        -> a -> c--- > (^$) :: Monoid m => Fold a m          -> a -> m--- > (^$) ::             Iso a b c d       -> a -> c--- > (^$) ::             Lens a b c d      -> a -> c--- > (^$) :: Monoid m => Traversal a b m d -> a -> m------ > (^$) :: ((c -> Const c d) -> a -> Const c b) -> a -> c-(^$) :: Getting c a b c d -> a -> c-l ^$ a = getConst (l Const a)-{-# INLINE (^$) #-}---- | View the value pointed to by a 'Getter' or 'Lens' or the result of folding over--- all the results of a 'Fold' or 'Traversal' that points at a monoidal values.------ This is the same operation as 'view' with the arguments flipped.------ The fixity and semantics are such that subsequent field accesses can be--- performed with (Prelude..)------ > ghci> ((0, 1 :+ 2), 3)^._1._2.to magnitude--- > 2.23606797749979------ > (^.) ::             a -> Getter a c        -> c--- > (^.) :: Monoid m => a -> Fold a m          -> m--- > (^.) ::             a -> Iso a b c d       -> c--- > (^.) ::             a -> Lens a b c d      -> c--- > (^.) :: Monoid m => a -> Traversal a b m d -> m------ > (^.) :: a -> ((c -> Const c d) -> a -> Const c b) -> c-(^.) :: a -> Getting c a b c d -> c-a ^. l = getConst (l Const a)-{-# INLINE (^.) #-}----------------------------------------------------------------------------------- Common Lenses----------------------------------------------------------------------------------- | This is a lens that can change the value (and type) of the first field of--- a pair.------ > ghci> (1,2)^._1--- > 1------ > ghci> _1 +~ "hello" $ (1,2)--- > ("hello",2)------ > _1 :: Functor f => (a -> f b) -> (a,c) -> f (a,c)-_1 :: Lens (a,c) (b,c) a b-_1 f (a,c) = (\b -> (b,c)) <$> f a-{-# INLINE _1 #-}---- | As '_1', but for the second field of a pair.------ > anyOf _2 :: (c -> Bool) -> (a, c) -> Bool--- > traverse._2 :: (Applicative f, Traversable t) => (a -> f b) -> t (c, a) -> f (t (c, b))--- > foldMapOf (traverse._2) :: (Traversable t, Monoid m) => (c -> m) -> t (b, c) -> m------ > _2 :: Functor f => (a -> f b) -> (c,a) -> f (c,b)-_2 :: Lens (c,a) (c,b) a b-_2 f (c,a) = (,) c <$> f a-{-# INLINE _2 #-}---- | A 'Lens' to view/edit the nth element 'elementOf' a 'Traversal', 'Lens' or 'Iso'.------ Attempts to access beyond the range of the 'Traversal' will cause an error.------ > ghci> [[1],[3,4]]^.elementOf (traverse.traverse) 1--- > 3-elementOf :: Functor f => LensLike (ElementOf f) a b c c -> Int -> LensLike f a b c c-elementOf l i f a = case getElementOf (l go a) 0 of-    Found _ fb -> fb-    Searching _ _ -> error "elementOf: index out of range"-  where-    go c = ElementOf $ \j -> if i == j then Found (j + 1) (f c) else Searching (j + 1) c---- | Access the nth element of a 'Traversable' container.------ Attempts to access beyond the range of the 'Traversal' will cause an error.------ > element = elementOf traverse-element :: Traversable t => Int -> Simple Lens (t a) a-element = elementOf traverse---- | This lens can be used to change the result of a function but only where--- the arguments match the key given.-resultAt :: Eq e => e -> Simple Lens (e -> a) a-resultAt e afa ea = go <$> afa a where-  a = ea e-  go a' e' | e == e'   = a'-           | otherwise = a-{-# INLINE resultAt #-}----------------------------------------------------------------------------------- MonadWriter----------------------------------------------------------------------------------- | Tell a part of a value to a 'MonadWriter', filling in the rest from 'mempty'------ > whisper l d = tell (set l d mempty)---- > whisper :: (MonadWriter b m, Monoid a) => Iso a b c d       -> d -> m ()--- > whisper :: (MonadWriter b m, Monoid a) => Lens a b c d      -> d -> m ()--- > whisper :: (MonadWriter b m, Monoid a) => Traversal a b c d -> d -> m ()--- > whisper :: (MonadWriter b m, Monoid a) => Setter a b c d    -> d -> m ()------ > whisper :: (MonadWriter b m, Monoid a) => ((c -> Identity d) -> a -> Identity b) -> d -> m ()-whisper :: (MonadWriter b m, Monoid a) => Setter a b c d -> d -> m ()-whisper l d = tell (set l d mempty)-{-# INLINE whisper #-}----------------------------------------------------------------------------------- MonadReader----------------------------------------------------------------------------------- |--- Query the target of a 'Lens', 'Iso' or 'Getter' in the current state, or use a--- summary of a 'Fold' or 'Traversal' that points to a monoidal value.------ > query :: MonadReader a m             => Getter a c        -> m c--- > query :: (MonadReader a m, Monoid c) => Fold a c          -> m c--- > query :: MonadReader a m             => Iso a b c d       -> m c--- > query :: MonadReader a m             => Lens a b c d      -> m c--- > query :: (MonadReader a m, Monoid c) => Traversal a b c d -> m c------ > query :: MonadReader a m => ((c -> Const c d) -> a -> Const c b) -> m c-query :: MonadReader a m => Getting c a b c d -> m c-query l = Reader.asks (^.l)-{-# INLINE query #-}---- |--- Use the target of a 'Lens', 'Iso' or 'Getter' in the current state, or use a--- summary of a 'Fold' or 'Traversal' that points to a monoidal value.------ > queries :: MonadReader a m             => Getter a c        -> (c -> e) -> m e--- > queries :: (MonadReader a m, Monoid c) => Fold a c          -> (c -> e) -> m e--- > queries :: MonadReader a m             => Iso a b c d       -> (c -> e) -> m e--- > queries :: MonadReader a m             => Lens a b c d      -> (c -> e) -> m e--- > queries :: (MonadReader a m, Monoid c) => Traversal a b c d -> (c -> e) -> m e------ > queries :: MonadReader a m => ((c -> Const e d) -> a -> Const e b) -> (c -> e) -> m e-queries :: MonadReader a m => Getting e a b c d -> (c -> e) -> m e-queries l f = Reader.asks (views l f)-{-# INLINE queries #-}----------------------------------------------------------------------------------- MonadState----------------------------------------------------------------------------------- |--- Use the target of a 'Lens', 'Iso', or 'Getter' in the current state, or use a--- summary of a 'Fold' or 'Traversal' that points to a monoidal value.------ > use :: MonadState a m             => Getter a c        -> m c--- > use :: (MonadState a m, Monoid r) => Fold a r          -> m r--- > use :: MonadState a m             => Iso a b c d       -> m c--- > use :: MonadState a m             => Lens a b c d      -> m c--- > use :: (MonadState a m, Monoid r) => Traversal a b r d -> m r------ > use :: MonadState a m => ((c -> Const c d) -> a -> Const c b) -> m c-use :: MonadState a m => Getting c a b c d -> m c-use l = State.gets (^.l)-{-# INLINE use #-}---- |--- Use the target of a 'Lens', 'Iso' or 'Getter' in the current state, or use a--- summary of a 'Fold' or 'Traversal' that points to a monoidal value.------ > uses :: MonadState a m             => Getter a c        -> (c -> e) -> m e--- > uses :: (MonadState a m, Monoid r) => Fold a c          -> (c -> r) -> m r--- > uses :: MonadState a m             => Lens a b c d      -> (c -> e) -> m e--- > uses :: MonadState a m             => Iso a b c d       -> (c -> e) -> m e--- > uses :: (MonadState a m, Monoid r) => Traversal a b c d -> (c -> r) -> m r------ > uses :: MonadState a m => ((c -> Const e d) -> a -> Const e b) -> (c -> e) -> m e-uses :: MonadState a m => Getting e a b c d -> (c -> e) -> m e-uses l f = State.gets (views l f)-{-# INLINE uses #-}----- | Replace the target of a 'Lens' or all of the targets of a 'Setter' or 'Traversal' in our monadic--- state with a new value, irrespective of the old.------ > (^=) :: MonadState a m => Iso a a c d       -> d -> m ()--- > (^=) :: MonadState a m => Lens a a c d      -> d -> m ()--- > (^=) :: MonadState a m => 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."-(^=) :: MonadState a m => Setter a a c d -> d -> m ()-l ^= b = State.modify (l ^~ b)-{-# INLINE (^=) #-}---- | Map over the target of a 'Lens' or all of the targets of a 'Setter' or 'Traversal in our monadic state.------ > (%=) :: MonadState a m => Iso a a c d       -> (c -> d) -> m ()--- > (%=) :: MonadState a m => Lens a a c d      -> (c -> d) -> m ()--- > (%=) :: MonadState a m => Traversal a a c d -> (c -> d) -> m ()--- > (%=) :: MonadState a m => Setter a a c d    -> (c -> d) -> m ()-(%=) :: MonadState a m => Setter a a c d -> (c -> d) -> m ()-l %= f = State.modify (l %~ f)-{-# INLINE (%=) #-}---- | Modify the target(s) of a 'Simple' 'Lens', 'Iso', 'Setter' or 'Traversal' by adding a value------ Example:------ > fresh = do--- >   id += 1--- >   access id-(+=) :: (MonadState a m, Num b) => Simple Setter a b -> b -> m ()-l += b = State.modify (l +~ b)-{-# INLINE (+=) #-}---- | Modify the target(s) of a 'Simple' 'Lens', 'Iso', 'Setter' or 'Traversal' by subtracting a value-(-=) :: (MonadState a m, Num b) => Simple Setter a b -> b -> m ()-l -= b = State.modify (l -~ b)-{-# INLINE (-=) #-}---- | Modify the target(s) of a 'Simple' 'Lens', 'Iso', 'Setter' or 'Traversal' by multiplying by value-(*=) :: (MonadState a m, Num b) => Simple Setter a b -> b -> m ()-l *= b = State.modify (l *~ b)-{-# INLINE (*=) #-}---- | Modify the target(s) of a 'Simple' 'Lens', 'Iso', 'Setter' or 'Traversal' by dividing by a value-(//=) ::  (MonadState a m, Fractional b) => Simple Setter a b -> b -> m ()-l //= b = State.modify (l //~ b)-{-# INLINE (//=) #-}---- | Modify the target(s) of a 'Simple' 'Lens', 'Iso', 'Setter' or 'Traversal' by taking their logical '&&' with a value-(&&=):: MonadState a m => Simple Setter a Bool -> Bool -> m ()-l &&= b = State.modify (l &&~ b)-{-# INLINE (&&=) #-}---- | Modify the target(s) of a 'Simple' 'Lens', 'Iso, 'Setter' or 'Traversal' by taking their logical '||' with a value-(||=) :: MonadState a m => Simple Setter a Bool -> Bool -> m ()-l ||= b = State.modify (l ||~ b)-{-# INLINE (||=) #-}---- | 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 ()-l <>= b = State.modify (l <>~ b)-{-# INLINE (<>=) #-}------------------------------- Folds------------------------------ | A 'Fold' describes how to retrieve multiple values in a way that can be composed--- with other lens-like constructions.------ A @'Fold' a c@ provides a structure with operations very similar to those of the 'Foldable'--- typeclass, see 'foldMapOf' and the other 'Fold' combinators.------ By convention, if there exists a 'foo' method that expects a @'Foldable' (f c)@, then there should be a--- 'fooOf' method that takes a @'Fold' a c@ and a value of type @a@.------ A 'Getter' is a legal 'Fold' that just ignores the supplied 'Monoid'------ Unlike a 'Traversal' a 'Fold' is read-only. Since a 'Fold' cannot be used to write back--- there are no lens laws that apply.------ > type Fold a c = forall m b d. Monoid m => Getting m a b c d-type Fold a c = forall m b d. Monoid m => (c -> Const m d) -> a -> Const m b---- | Build a 'Getter' or 'Fold' from a 'foldMap'-like function.------ > folds :: ((c -> m) -> a -> m) -> (c -> Const m d) -> a -> Const m b--- > folds :: ((c -> m) -> a -> m) -> Getting m a b c d-folds :: Isomorphic k => k ((c -> m) -> a -> m) (Getting m a b c d)-folds = isomorphic (\l f -> Const . l (getConst . f))-                   (\l f -> getConst . l (Const . f))-{-# INLINE folds #-}-{-# SPECIALIZE folds :: ((c -> m) -> a -> m) -> Getting m a b c d #-}-{-# SPECIALIZE folds :: Isomorphism ((c -> m) -> a -> m) (Getting m a b c d) #-}---- | 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'.-folding :: Foldable f => (a -> f c) -> Fold a c-folding f g = Const . foldMap (getConst . g) . f-{-# INLINE folding #-}---- | Obtain a 'Fold' from any 'Foldable'.------ > folded = folds foldMap-folded :: Foldable f => Fold (f c) c-folded = folds foldMap-{-# INLINE folded #-}---- | Fold by repeating the input forever.------ > repeat = toListOf repeated-repeated :: Fold a a-repeated f a = Const as where as = getConst (f a) `mappend` as---- | A fold that replicates its input @n@ times.------ > replicate n = toListOf (replicated n)-replicated :: Int -> Fold a a-replicated n0 f a = Const (go n0) where-  m = getConst (f a)-  go 0 = mempty-  go n = m `mappend` go (n - 1)-{-# INLINE replicated #-}---- | Transform a fold into a fold that loops over its elements over and over.------ > ghci> toListOf (cycled traverse) [1,2,3]--- > [1,2,3,1,2,3,..]-cycled :: Monoid m => Getting m a b c d -> Getting m a b c d-cycled l f a = Const as where as = getConst (l f a) `mappend` as---- | Build a fold that unfolds its values from a seed.------ > ghci> unfoldr = toListOf . unfolded-unfolded :: (b -> Maybe (a, b)) -> Fold b a-unfolded f g b0 = go b0 where-  go b = case f b of-    Just (a, b') -> g a *> go b'-    Nothing      -> Const mempty-{-# INLINE unfolded #-}----- | @x ^. 'iterated' f@ Return an infinite fold of repeated applications of @f@ to @x@.------ > toListOf (iterated f) a = iterate f a-iterated :: (a -> a) -> Fold a a-iterated f g a0 = go a0 where-  go a = g a *> go (f a)-{-# INLINE iterated #-}---- | Obtain a 'Fold' by filtering a 'Lens', 'Iso', 'Getter', 'Fold' or 'Traversal'.-filtered :: Monoid m => (c -> Bool) -> Getting m a b c d -> Getting m a b c d-filtered p l f = l (\c -> if p c then f c else Const mempty)-{-# INLINE filtered #-}---- | Obtain a 'Fold' by reversing the order of traversal for a 'Lens', 'Iso', 'Getter', 'Fold' or 'Traversal'.------ Of course, reversing a 'Lens', 'Iso' or 'Getter' has no effect.-reversed :: Getting (Dual m) a b c d -> Getting m a b c d-reversed l f = Const . getDual . getConst . l (Const .  Dual . getConst . f)-{-# INLINE reversed #-}----taking :: Int -> Getting (Taking m) a b c d -> Getting m a b c d---dropping :: Int -> Getting (Dropping m) a b c d -> Getting m a b c d---- | Obtain a 'Fold' by taking elements from another 'Fold', 'Lens', 'Iso', 'Getter' or 'Traversal' while a predicate holds.------ > takeWhile p = toListOf (takingWhile p folded)------ > ghci> toList (takingWhile (<=3) folded) [1..]--- > [1,2,3]-takingWhile :: Monoid m => (c -> Bool) -> Getting (Endo m) a b c d -> Getting m a b c d-takingWhile p l f = Const . foldrOf l (\a r -> if p a then getConst (f a) `mappend` r else mempty) mempty-{-# INLINE takingWhile #-}---- | Obtain a 'Fold' by dropping elements from another 'Fold', 'Lens', 'Iso', 'Getter' or 'Traversal' while a predicate holds.------ > dropWhile p = toListOf (droppingWhile p folded)------ > ghci> toList (dropWhile (<=3) folded) [1..6]--- > [4,5,6]-droppingWhile :: Monoid m => (c -> Bool) -> Getting (Endo m) a b c d -> Getting m a b c d-droppingWhile p l f = Const . foldrOf l (\a r -> if p a then mempty else mappend r (getConst (f a))) mempty-{-# INLINE droppingWhile #-}------------------------------- Fold/Getter combinators------------------------------- |--- > foldMap = foldMapOf folded------ > foldMapOf = views--- > foldMapOf = from folds------ > foldMapOf ::             Getter a c        -> (c -> m) -> a -> m--- > foldMapOf :: Monoid m => Fold a c          -> (c -> m) -> a -> m--- > foldMapOf ::             Lens a b c d      -> (c -> m) -> a -> m--- > foldMapOf ::             Iso a b c d       -> (c -> m) -> a -> m--- > foldMapOf :: Monoid m => Traversal a b c d -> (c -> m) -> a -> m------ > foldMapOf :: Getting m a b c d -> (c -> m) -> a -> m-foldMapOf :: Isomorphic k => k (Getting m a b c d) ((c -> m) -> a -> m)-foldMapOf = isomorphic (\l f -> getConst . l (Const . f))-                       (\l f -> Const . l (getConst . f))-{-# INLINE foldMapOf #-}-{-# SPECIALIZE foldMapOf :: Getting m a b c d -> (c -> m) -> a -> m #-}---- |--- > fold = foldOf folded------ > foldOf = view------ > foldOf ::             Getter a m        -> a -> m--- > foldOf :: Monoid m => Fold a m          -> a -> m--- > foldOf ::             Lens a b m d      -> a -> m--- > foldOf ::             Iso a b m d       -> a -> m--- > foldOf :: Monoid m => Traversal a b m d -> a -> m-foldOf :: Getting m a b m d -> a -> m-foldOf l = getConst . l Const-{-# INLINE foldOf #-}---- |--- Right-associative fold of parts of a structure that are viewed through a 'Lens', 'Getter', 'Fold' or 'Traversal'.------ > foldr = foldrOf folded------ > foldrOf :: Getter a c        -> (c -> e -> e) -> e -> a -> e--- > foldrOf :: Fold a c          -> (c -> e -> e) -> e -> a -> e--- > foldrOf :: Lens a b c d      -> (c -> e -> e) -> e -> a -> e--- > foldrOf :: Iso a b c d       -> (c -> e -> e) -> e -> a -> e--- > foldrOf :: Traversal a b c d -> (c -> e -> e) -> e -> a -> e-foldrOf :: Getting (Endo e) a b c d -> (c -> e -> e) -> e -> a -> e-foldrOf l f z t = appEndo (foldMapOf l (Endo . f) t) z-{-# INLINE foldrOf #-}---- |--- Left-associative fold of the parts of a structure that are viewed through a 'Lens', 'Getter', 'Fold' or 'Traversal'.------ > foldl = foldlOf folded------ > foldlOf :: Getter a c        -> (e -> c -> e) -> e -> a -> e--- > foldlOf :: Fold a c          -> (e -> c -> e) -> e -> a -> e--- > foldlOf :: Lens a b c d      -> (e -> c -> e) -> e -> a -> e--- > foldlOf :: Iso a b c d       -> (e -> c -> e) -> e -> a -> e--- > foldlOf :: Traversal a b c d -> (e -> c -> e) -> e -> a -> e-foldlOf :: Getting (Dual (Endo e)) a b c d -> (e -> c -> e) -> e -> a -> e-foldlOf l f z t = appEndo (getDual (foldMapOf l (Dual . Endo . flip f) t)) z-{-# INLINE foldlOf #-}---- |--- > toList = toListOf folded------ > toListOf :: Getter a c        -> a -> [c]--- > toListOf :: Fold a c          -> a -> [c]--- > toListOf :: Lens a b c d      -> a -> [c]--- > toListOf :: Iso a b c d       -> a -> [c]--- > toListOf :: Traversal a b c d -> a -> [c]-toListOf :: Getting [c] a b c d -> a -> [c]-toListOf l = foldMapOf l return-{-# INLINE toListOf #-}---- |--- > and = andOf folded------ > andOf :: Getter a Bool       -> a -> Bool--- > andOf :: Fold a Bool         -> a -> Bool--- > andOf :: Lens a b Bool d     -> a -> Bool--- > andOf :: Iso a b Bool d      -> a -> Bool--- > andOf :: Traversl a b Bool d -> a -> Bool-andOf :: Getting All a b Bool d -> a -> Bool-andOf l = getAll . foldMapOf l All-{-# INLINE andOf #-}---- |--- > or = orOf folded------ > orOf :: Getter a Bool        -> a -> Bool--- > orOf :: Fold a Bool          -> a -> Bool--- > orOf :: Lens a b Bool d      -> a -> Bool--- > orOf :: Iso a b Bool d       -> a -> Bool--- > orOf :: Traversal a b Bool d -> a -> Bool-orOf :: Getting Any a b Bool d -> a -> Bool-orOf l = getAny . foldMapOf l Any-{-# INLINE orOf #-}---- |--- > any = anyOf folded------ > anyOf :: Getter a c        -> (c -> Bool) -> a -> Bool--- > anyOf :: Fold a c          -> (c -> Bool) -> a -> Bool--- > anyOf :: Lens a b c d      -> (c -> Bool) -> a -> Bool--- > anyOf :: Iso a b c d       -> (c -> Bool) -> a -> Bool--- > anyOf :: Traversal a b c d -> (c -> Bool) -> a -> Bool-anyOf :: Getting Any a b c d -> (c -> Bool) -> a -> Bool-anyOf l f = getAny . foldMapOf l (Any . f)-{-# INLINE anyOf #-}---- |--- > all = allOf folded------ > allOf :: Getter a c        -> (c -> Bool) -> a -> Bool--- > allOf :: Fold a c          -> (c -> Bool) -> a -> Bool--- > allOf :: Lens a b c d      -> (c -> Bool) -> a -> Bool--- > allOf :: Iso a b c d       -> (c -> Bool) -> a -> Bool--- > allOf :: Traversal a b c d -> (c -> Bool) -> a -> Bool-allOf :: Getting All a b c d -> (c -> Bool) -> a -> Bool-allOf l f = getAll . foldMapOf l (All . f)-{-# INLINE allOf #-}---- |--- > product = productOf folded------ > productOf ::          Getter a c        -> a -> c--- > productOf :: Num c => Fold a c          -> a -> c--- > productOf ::          Lens a b c d      -> a -> c--- > productOf ::          Iso a b c d       -> a -> c--- > productOf :: Num c => Traversal a b c d -> a -> c-productOf :: Getting (Product c) a b c d -> a -> c-productOf l = getProduct . foldMapOf l Product-{-# INLINE productOf #-}---- |--- > sum = sumOf folded------ > sumOf _1 :: (a, b) -> a--- > 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 ::          Lens a b c d      -> a -> c--- > sumOf ::          Iso a b c d       -> a -> c--- > sumOf :: Num c => Traversal a b c d -> a -> c-sumOf :: Getting (Sum c) a b c d -> a -> c-sumOf l = getSum . foldMapOf l Sum-{-# INLINE sumOf #-}---- |------ When passed a 'Getter', 'traverseOf_' can work over a 'Functor'.------ When passed a 'Fold', 'traverseOf_' requires an 'Applicative'.------ > traverse_ = traverseOf_ folded------ > traverseOf_ _2 :: Functor f => (c -> f e) -> (c1, c) -> f ()--- > traverseOf_ traverseLeft :: Applicative f => (a -> f b) -> Either a c -> f ()------ The rather specific signature of traverseOf_ allows it to be used as if the signature was either:------ > traverseOf_ :: Functor f     => Getter a c        -> (c -> f e) -> a -> f ()--- > traverseOf_ :: Applicative f => Fold a c          -> (c -> f e) -> a -> f ()--- > traverseOf_ :: Functor f     => Lens a b c d      -> (c -> f e) -> a -> f ()--- > traverseOf_ :: Functor f     => Iso a b c d       -> (c -> f e) -> a -> f ()--- > traverseOf_ :: Applicative f => Traversal a b c d -> (c -> f e) -> a -> f ()-traverseOf_ :: Functor f => Getting (Traversed f) a b c d -> (c -> f e) -> a -> f ()-traverseOf_ l f = getTraversed . foldMapOf l (Traversed . void . f)-{-# INLINE traverseOf_ #-}---- |--- > 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     => Lens a b c d      -> a -> (c -> f e) -> f ()--- > forOf_ :: Functor f     => Iso a b c d       -> a -> (c -> f e) -> f ()--- > forOf_ :: Applicative f => Traversal a b c d -> a -> (c -> f e) -> f ()-forOf_ :: Functor f => Getting (Traversed f) a b c d -> a -> (c -> f e) -> f ()-forOf_ l a f = traverseOf_ l f a-{-# INLINE forOf_ #-}---- |--- > sequenceA_ = sequenceAOf_ folded------ > sequenceAOf_ :: Functor f     => Getter a (f ())        -> a -> f ()--- > sequenceAOf_ :: Applicative f => Fold a (f ())          -> a -> f ()--- > sequenceAOf_ :: Functor f     => Lens a b (f ()) d      -> a -> f ()--- > sequenceAOf_ :: Functor f     => Iso a b (f ()) d       -> a -> f ()--- > sequenceAOf_ :: Applicative f => Traversal a b (f ()) d -> a -> f ()-sequenceAOf_ :: Functor f => Getting (Traversed f) a b (f ()) d -> a -> f ()-sequenceAOf_ l = getTraversed . foldMapOf l (Traversed . void)-{-# INLINE sequenceAOf_ #-}---- |--- > 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 => Lens a b c d      -> (c -> m e) -> a -> m ()--- > mapMOf_ :: Monad m => Iso a b c d       -> (c -> m e) -> a -> m ()--- > mapMOf_ :: Monad m => Traversal a b c d -> (c -> m e) -> a -> m ()-mapMOf_ :: Monad m => Getting (Action m) a b c d -> (c -> m e) -> a -> m ()-mapMOf_ l f = getAction . foldMapOf l (Action . liftM skip . f)-{-# INLINE mapMOf_ #-}---- |--- > 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 => Lens a b c d      -> a -> (c -> m e) -> m ()--- > forMOf_ :: Monad m => Iso a b c d       -> a -> (c -> m e) -> m ()--- > forMOf_ :: Monad m => Traversal a b c d -> a -> (c -> m e) -> m ()-forMOf_ :: Monad m => Getting (Action m) a b c d -> a -> (c -> m e) -> m ()-forMOf_ l a f = mapMOf_ l f a-{-# INLINE forMOf_ #-}---- |--- > sequence_ = sequenceOf_ folded------ > sequenceOf_ :: Monad m => Getter a (m b)        -> a -> m ()--- > sequenceOf_ :: Monad m => Fold a (m b)          -> a -> m ()--- > sequenceOf_ :: Monad m => Lens a b (m b) d      -> a -> m ()--- > sequenceOf_ :: Monad m => Iso a b (m b) d       -> a -> m ()--- > sequenceOf_ :: Monad m => Traversal a b (m b) d -> a -> m ()-sequenceOf_ :: Monad m => Getting (Action m) a b (m c) d -> a -> m ()-sequenceOf_ l = getAction . foldMapOf l (Action . liftM skip)-{-# INLINE sequenceOf_ #-}---- | The sum of a collection of actions, generalizing 'concatOf'.------ > asum = asumOf folded------ > asumOf :: Alternative f => Getter a c        -> a -> f c--- > asumOf :: Alternative f => Fold a c          -> a -> f c--- > asumOf :: Alternative f => Lens a b c d      -> a -> f c--- > asumOf :: Alternative f => Iso a b c d       -> a -> f c--- > asumOf :: Alternative f => Traversal a b c d -> a -> f c-asumOf :: Alternative f => Getting (Endo (f c)) a b (f c) d -> a -> f c-asumOf l = foldrOf l (<|>) Applicative.empty-{-# INLINE asumOf #-}---- | The sum of a collection of actions, generalizing 'concatOf'.------ > msum = msumOf folded------ > msumOf :: MonadPlus m => Getter a c        -> a -> m c--- > msumOf :: MonadPlus m => Fold a c          -> a -> m c--- > msumOf :: MonadPlus m => Lens a b c d      -> a -> m c--- > msumOf :: MonadPlus m => Iso a b c d       -> a -> m c--- > msumOf :: MonadPlus m => Traversal a b c d -> a -> m c-msumOf :: MonadPlus m => Getting (Endo (m c)) a b (m c) d -> a -> m c-msumOf l = foldrOf l mplus mzero-{-# INLINE msumOf #-}---- |--- > elem = elemOf folded------ > elemOf :: Eq c => Getter a c        -> c -> a -> Bool--- > elemOf :: Eq c => Fold a c          -> c -> a -> Bool--- > elemOf :: Eq c => Lens a b c d      -> c -> a -> Bool--- > elemOf :: Eq c => Iso a b c d       -> c -> a -> Bool--- > elemOf :: Eq c => Traversal a b c d -> c -> a -> Bool-elemOf :: Eq c => Getting Any a b c d -> c -> a -> Bool-elemOf l = anyOf l . (==)-{-# INLINE elemOf #-}---- |--- > notElem = notElemOf folded------ > notElemOf :: Eq c => Getter a c        -> c -> a -> Bool--- > notElemOf :: Eq c => Fold a c          -> c -> a -> Bool--- > notElemOf :: Eq c => Iso a b c d       -> c -> a -> Bool--- > notElemOf :: Eq c => Lens a b c d      -> c -> a -> Bool--- > notElemOf :: Eq c => Traversal a b c d -> c -> a -> Bool-notElemOf :: Eq c => Getting All a b c d -> c -> a -> Bool-notElemOf l = allOf l . (/=)-{-# INLINE notElemOf #-}---- |--- > concatMap = concatMapOf folded------ > concatMapOf :: Getter a c        -> (c -> [e]) -> a -> [e]--- > concatMapOf :: Fold a c          -> (c -> [e]) -> a -> [e]--- > concatMapOf :: Lens a b c d      -> (c -> [e]) -> a -> [e]--- > concatMapOf :: Iso a b c d       -> (c -> [e]) -> a -> [e]--- > concatMapOf :: Traversal a b c d -> (c -> [e]) -> a -> [e]-concatMapOf :: Getting [e] a b c d -> (c -> [e]) -> a -> [e]-concatMapOf l ces a = getConst  (l (Const . ces) a)-{-# INLINE concatMapOf #-}---- |--- > concat = concatOf folded------ > concatOf :: Getter a [e]        -> a -> [e]--- > concatOf :: Fold a [e]          -> a -> [e]--- > concatOf :: Iso a b [e] d       -> a -> [e]--- > concatOf :: Lens a b [e] d      -> a -> [e]--- > concatOf :: Traversal a b [e] d -> a -> [e]-concatOf :: Getting [e] a b [e] d -> a -> [e]-concatOf = view-{-# INLINE concatOf #-}---- |--- Note: this can be rather inefficient for large containers.------ > length = lengthOf folded------ > lengthOf _1 :: (a, b) -> Int--- > lengthOf _1 = 1--- > lengthOf (folded.folded) :: Foldable f => f (g a) -> Int------ > lengthOf :: Getter a c        -> a -> Int--- > lengthOf :: Fold a c          -> a -> Int--- > lengthOf :: Lens a b c d      -> a -> Int--- > lengthOf :: Iso a b c d       -> a -> Int--- > lengthOf :: Traversal a b c d -> a -> Int-lengthOf :: Getting (Sum Int) a b c d -> a -> Int-lengthOf l = getSum . foldMapOf l (\_ -> Sum 1)-{-# INLINE lengthOf #-}---- | Perform a safe 'head' of a 'Fold' or 'Traversal' or retrieve 'Just' the result--- from a 'Getter' or 'Lens'.------ > listToMaybe . toList = headOf folded------ > headOf :: Getter a c        -> a -> Maybe c--- > headOf :: Fold a c          -> a -> Maybe c--- > headOf :: Lens a b c d      -> a -> Maybe c--- > headOf :: Iso a b c d       -> a -> Maybe c--- > headOf :: Traversal a b c d -> a -> Maybe c-headOf :: Getting (First c) a b c d -> a -> Maybe c-headOf l = getFirst . foldMapOf l (First . Just)-{-# INLINE headOf #-}---- | Perform a safe 'last' of a 'Fold' or '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 :: Lens a b c d      -> a -> Maybe c--- > lastOf :: Iso a b c d       -> a -> Maybe c--- > lastOf :: Traversal a b c d -> a -> Maybe c-lastOf :: Getting (Last c) a b c d -> a -> Maybe c-lastOf l = getLast . foldMapOf l (Last . Just)-{-# INLINE lastOf #-}---- |--- Returns 'True' if this 'Fold' or 'Traversal' has no targets in the given container.------ Note: nullOf on a valid 'Iso', 'Lens' or 'Getter' should always return 'False'------ > null = nullOf folded------ This may be rather inefficient compared to the 'null' check of many containers.------ > nullOf _1 :: (a, b) -> Int--- > nullOf _1 = False--- > nullOf (folded._1.folded) :: Foldable f => f (g a, b) -> Bool------ > nullOf :: Getter a c        -> a -> Bool--- > nullOf :: Fold a c          -> a -> Bool--- > nullOf :: Iso a b c d       -> a -> Bool--- > nullOf :: Lens a b c d      -> a -> Bool--- > nullOf :: Traversal a b c d -> a -> Bool-nullOf :: Getting All a b c d -> a -> Bool-nullOf l = getAll . foldMapOf l (\_ -> All False)-{-# INLINE nullOf #-}---- |--- Obtain the maximum element (if any) targeted by a 'Fold' or 'Traversal'------ Note: maximumOf on a valid 'Iso', 'Lens' or 'Getter' will always return 'Just' a value.------ > maximum = fromMaybe (error "empty") . maximumOf folded------ > maximumOf ::          Getter a c        -> a -> Maybe c--- > maximumOf :: Ord c => Fold a c          -> a -> Maybe c--- > maximumOf ::          Iso a b c d       -> a -> Maybe c--- > maximumOf ::          Lens a b c d      -> a -> Maybe c--- > maximumOf :: Ord c => Traversal a b c d -> a -> Maybe c-maximumOf :: Getting (Max c) a b c d -> a -> Maybe c-maximumOf l = getMax . foldMapOf l Max-{-# INLINE maximumOf #-}---- |--- Obtain the minimum element (if any) targeted by a 'Fold' or 'Traversal'------ Note: minimumOf on a valid 'Iso', 'Lens' or 'Getter' will always return 'Just' a value.------ > minimum = fromMaybe (error "empty") . minimumOf folded------ > minimumOf ::          Getter a c        -> a -> Maybe c--- > minimumOf :: Ord c => Fold a c          -> a -> Maybe c--- > minimumOf ::          Iso a b c d       -> a -> Maybe c--- > minimumOf ::          Lens a b c d      -> a -> Maybe c--- > minimumOf :: Ord c => Traversal a b c d -> a -> Maybe c-minimumOf :: Getting (Min c) a b c d -> a -> Maybe c-minimumOf l = getMin . foldMapOf l Min-{-# INLINE minimumOf #-}---- |--- Obtain the maximum element (if any) targeted by a 'Fold', 'Traversal', 'Lens', 'Iso',--- or 'Getter' according to a user supplied ordering.------ > maximumBy cmp = 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 :: Iso a b c d       -> (c -> c -> Ordering) -> a -> Maybe c--- > maximumByOf :: Lens a b c d      -> (c -> c -> Ordering) -> a -> Maybe c--- > maximumByOf :: Traversal a b c d -> (c -> c -> Ordering) -> a -> Maybe c-maximumByOf :: Getting (Endo (Maybe c)) a b c d -> (c -> c -> Ordering) -> a -> Maybe c-maximumByOf l cmp = foldrOf l step Nothing where-  step a Nothing  = Just a-  step a (Just b) = Just (if cmp a b == GT then a else b)-{-# INLINE maximumByOf #-}---- |--- Obtain the minimum element (if any) targeted by a 'Fold', 'Traversal', 'Lens', 'Iso'--- or 'Getter' according to a user supplied ordering.------ > 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 :: Iso a b c d       -> (c -> c -> Ordering) -> a -> Maybe c--- > minimumByOf :: Lens a b c d      -> (c -> c -> Ordering) -> a -> Maybe c--- > minimumByOf :: Traversal a b c d -> (c -> c -> Ordering) -> a -> Maybe c-minimumByOf :: Getting (Endo (Maybe c)) a b c d -> (c -> c -> Ordering) -> a -> Maybe c-minimumByOf l cmp = foldrOf l step Nothing where-  step a Nothing  = Just a-  step a (Just b) = Just (if cmp a b == GT then b else a)-{-# INLINE minimumByOf #-}---- | The 'findOf' function takes a lens (or , getter, iso, fold, or traversal),--- a predicate and a structure and returns the leftmost element of the structure--- 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 :: Iso a b c d       -> (c -> Bool) -> a -> Maybe c--- > findOf :: Lens a b c d      -> (c -> Bool) -> a -> Maybe c--- > findOf :: Traversal a b c d -> (c -> Bool) -> a -> Maybe c-findOf :: Getting (First c) a b c d -> (c -> Bool) -> a -> Maybe c-findOf l p = getFirst . foldMapOf l step where-  step c-    | p c       = First (Just c)-    | otherwise = First Nothing-{-# INLINE findOf #-}---- |--- A variant of 'foldrOf' that has no base case and thus may only be applied--- to lenses and structures such that the lens views at least one element of--- the structure.------ > foldr1Of l f = Prelude.foldr1 f . toListOf l------ > foldr1 = foldr1Of folded------ > foldr1Of :: Getter a c        -> (c -> c -> c) -> a -> c--- > foldr1Of :: Fold a c          -> (c -> c -> c) -> a -> c--- > foldr1Of :: Iso a b c d       -> (c -> c -> c) -> a -> c--- > foldr1Of :: Lens a b c d      -> (c -> c -> c) -> a -> c--- > foldr1Of :: Traversal a b c d -> (c -> c -> c) -> a -> c-foldr1Of :: Getting (Endo (Maybe c)) a b c d -> (c -> c -> c) -> a -> c-foldr1Of l f xs = fromMaybe (error "foldr1Of: empty structure")-                            (foldrOf l mf Nothing xs) where-  mf x Nothing = Just x-  mf x (Just y) = Just (f x y)-{-# INLINE foldr1Of #-}---- | A variant of 'foldlOf' that has no base case and thus may only be applied to lenses and strutures such--- that the lens views at least one element of the structure.------ > foldl1Of l f = Prelude.foldl1Of l f . toList------ > foldl1 = foldl1Of folded------ > foldl1Of :: Getter a c        -> (c -> c -> c) -> a -> c--- > foldl1Of :: Fold a c          -> (c -> c -> c) -> a -> c--- > foldl1Of :: Iso a b c d       -> (c -> c -> c) -> a -> c--- > foldl1Of :: Lens a b c d      -> (c -> c -> c) -> a -> c--- > foldl1Of :: Traversal a b c d -> (c -> c -> c) -> a -> c-foldl1Of :: Getting (Dual (Endo (Maybe c))) a b c d -> (c -> c -> c) -> a -> c-foldl1Of l f xs = fromMaybe (error "foldl1Of: empty structure") (foldlOf l mf Nothing xs) where-  mf Nothing y = Just y-  mf (Just x) y = Just (f x y)-{-# INLINE foldl1Of #-}---- | Strictly fold right over the elements of a structure.------ > foldr' = foldrOf' folded------ > foldrOf' :: Getter a c        -> (c -> e -> e) -> e -> a -> e--- > foldrOf' :: Fold a c          -> (c -> e -> e) -> e -> a -> e--- > foldrOf' :: Iso a b c d       -> (c -> e -> e) -> e -> a -> e--- > foldrOf' :: Lens a b c d      -> (c -> e -> e) -> e -> a -> e--- > foldrOf' :: Traversal a b c d -> (c -> e -> e) -> e -> a -> e-foldrOf' :: Getting (Dual (Endo (e -> e))) a b c d -> (c -> e -> e) -> e -> a -> e-foldrOf' l f z0 xs = foldlOf l f' id xs z0-  where f' k x z = k $! f x z-{-# INLINE foldrOf' #-}---- | Fold over the elements of a structure, associating to the left, but strictly.------ > foldl' = foldlOf' folded------ > foldlOf' :: Getter a c          -> (e -> c -> e) -> e -> a -> e--- > foldlOf' :: Fold a c            -> (e -> c -> e) -> e -> a -> e--- > foldlOf' :: Iso a b c d         -> (e -> c -> e) -> e -> a -> e--- > foldlOf' :: Lens a b c d        -> (e -> c -> e) -> e -> a -> e--- > foldlOf' :: Traversal a b c d   -> (e -> c -> e) -> e -> a -> e-foldlOf' :: Getting (Endo (e -> e)) a b c d -> (e -> c -> e) -> e -> a -> e-foldlOf' l f z0 xs = foldrOf l f' id xs z0-  where f' x k z = k $! f z x-{-# INLINE foldlOf' #-}---- | Monadic fold over the elements of a structure, associating to the right,--- i.e. from right to left.------ > 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 => Iso a b c d       -> (c -> e -> m e) -> e -> a -> m e--- > foldrMOf :: Monad m => Lens a b c d      -> (c -> e -> m e) -> e -> a -> m e--- > foldrMOf :: Monad m => Traversal a b c d -> (c -> e -> m e) -> e -> a -> m e-foldrMOf :: Monad m-         => Getting (Dual (Endo (e -> m e))) a b c d-         -> (c -> e -> m e) -> e -> a -> m e-foldrMOf l f z0 xs = foldlOf l f' return xs z0-  where f' k x z = f x z >>= k-{-# INLINE foldrMOf #-}---- | Monadic fold over the elements of a structure, associating to the left,--- i.e. from left to right.------ > 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 => Iso a b c d       -> (e -> c -> m e) -> e -> a -> m e--- > foldlMOf :: Monad m => Lens a b c d      -> (e -> c -> m e) -> e -> a -> m e--- > foldlMOf :: Monad m => Traversal a b c d -> (e -> c -> m e) -> e -> a -> m e-foldlMOf :: Monad m-         => Getting (Endo (e -> m e)) a b c d-         -> (e -> c -> m e) -> e -> a -> m e-foldlMOf l f z0 xs = foldrOf l f' return xs z0-  where f' x k z = f z x >>= k-{-# INLINE foldlMOf #-}----------------------------------------------------------------------------------- Traversals----------------------------------------------------------------------------------- | 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 #-}----------------------------------------------------------------------------------- Transforming Traversals----------------------------------------------------------------------------------- | This allows you to 'traverse' the elements of a 'Traversal' in the--- opposite order.------ Note: 'reversed' is similar, but is able to accept a 'Fold' (or 'Getter')--- and produce a 'Fold' (or 'Getter').------ This requires at least a 'Traversal' (or 'Lens') and can produce a--- 'Traversal' (or 'Lens') in turn.------ A backwards 'Iso' is the same 'Iso'. If you reverse the direction of--- the isomorphism use 'from' instead.-backwards :: Isomorphic k => Overloaded k (Backwards f) a b c d -> Overloaded k f a b c d-backwards = isomap-  (\l f -> forwards . l (Backwards . f))-  (\l f -> forwards . l (Backwards . f))-{-# INLINE backwards #-}-{-# SPECIALIZE backwards :: LensLike (Backwards f) a b c d -> LensLike f a b c d #-}-{-# SPECIALIZE backwards :: Overloaded Isomorphism (Backwards f) a b c d -> Overloaded Isomorphism f a b c d #-}---- | Merge two lenses, getters, setters, folds or traversals.-merged :: Functor f => LensLike f a b c c -> LensLike f a' b' c c -> LensLike f (Either a a') (Either b b') c c-merged l _ f (Left a)   = Left <$> l f a-merged _ r f (Right a') = Right <$> r f a'-{-# INLINE merged #-}---- | 'bothLenses' makes a lens from two other lenses (or isomorphisms)-bothLenses :: Lens a b c d -> Lens a' b' c' d' -> Lens (a,a') (b,b') (c,c') (d,d')-bothLenses 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')-{-# INLINE bothLenses #-}---------------------------------------------------------------------------------- Overloading function application---------------------------------------------------------------------------------- | > type LensLike f a b c d = Overloaded (->) f a b c d-type Overloaded k f a b c d = k (c -> f d) (a -> f b)---- | > type SimpleOverloaded k f a b = Simple (Overloaded k f) a b-type SimpleOverloaded k f a b = Overloaded k f a a b b---------------------------------------------------------------------------------- Isomorphisms families as Lenses---------------------------------------------------------------------------------- | Isomorphim families can be composed with other lenses using either' (.)' and 'id'--- from the Prelude or from Control.Category. However, if you compose them--- with each other using '(.)' from the Prelude, they will be dumbed down to a--- mere 'Lens'.------ > import Control.Category--- > import Prelude hiding ((.),id)------ > type Iso a b c d = forall k f. (Isomorphic k, Functor f) => Overloaded k f a b c d-type Iso a b c d = forall k f. (Isomorphic k, Functor f) => k (c -> f d) (a -> f b)---- | > type SimpleIso a b = Simple Iso a b-type SimpleIso a b = Iso a a b b---- | Build an isomorphism family from two pairs of inverse functions------ > isos :: (a -> c) -> (c -> a) -> (b -> d) -> (d -> b) -> Iso a b c d-isos :: (Isomorphic k, Functor f) => (a -> c) -> (c -> a) -> (b -> d) -> (d -> b) -> Overloaded k f a b c d-isos ac ca bd db = isomorphic-  (\cfd a -> db <$> cfd (ac a))-  (\afb c -> bd <$> afb (ca c))-{-# INLINE isos #-}-{-# SPECIALIZE isos :: Functor f => (a -> c) -> (c -> a) -> (b -> d) -> (d -> b) -> LensLike f a b c d #-}-{-# SPECIALIZE isos :: Functor f => (a -> c) -> (c -> a) -> (b -> d) -> (d -> b) -> Overloaded Isomorphism f a b c d #-}---- | Build a simple isomorphism from a pair of inverse functions------ > iso :: (a -> b) -> (b -> a) -> Simple Iso a b-iso :: (Isomorphic k, Functor f) => (a -> b) -> (b -> a) -> SimpleOverloaded k f a b-iso ab ba = isos ab ba ab ba-{-# INLINE iso #-}-{-# SPECIALIZE iso :: Functor f => (a -> b) -> (b -> a) -> SimpleLensLike f a b #-}-{-# SPECIALIZE iso :: Functor f => (a -> b) -> (b -> a) -> SimpleOverloaded Isomorphism f a b #-}---------------------------------------------------------------------------------- Isomorphism---------------------------------------------------------------------------------- | This isomorphism can be used to wrap or unwrap a value in 'Identity'.------ > x^.identity = Identity x--- > Identity x^.from identity = x-identity :: Iso a b (Identity a) (Identity b)-identity = isos Identity runIdentity Identity runIdentity-{-# INLINE identity #-}---- | This isomorphism can be used to wrap or unwrap a value in 'Const'------ > x^.konst = Const x--- > Const x^.from konst = x-konst :: Iso a b (Const a c) (Const b d)-konst = isos Const getConst Const getConst-{-# INLINE konst #-}----------------------------------------------------------------------------------- Cloning Lenses----------------------------------------------------------------------------------- |------ Cloning a 'Lens' is one way to make sure you arent given--- something weaker, such as a 'Traversal' and can be used--- as a way to pass around lenses that have to be monomorphic in 'f'.------ Note: This only accepts a proper 'Lens', because 'IndexedStore' lacks its--- (admissable) Applicative instance.----clone :: Functor f-      => LensLike (IndexedStore c d) a b c d-      -> (c -> f d) -> a -> f b-clone f cfd a = case f (IndexedStore id) a of-  IndexedStore db c -> db <$> cfd c-{-# INLINE clone #-}----------------------------------------------------------------------------------- Indexed Folds----------------------------------------------------------------------------------- | Every 'IndexedFold' is a valid 'Fold'-type IndexedFold i a c = forall k m b d. (Indexed i k, Monoid m) => k (c -> Const m d) (a -> Const m b)--type IndexedFolding i m a b c d = Index i (c -> Const m d) (a -> Const m b)---- |------ > foldMapWithIndexOf :: Monoid m => IndexedFold i a c          -> (i -> c -> m) -> a -> m--- > foldMapWithIndexOf :: Monoid m => IndexedTraversal i a b c d -> (i -> c -> m) -> a -> m-foldMapWithIndexOf :: IndexedFolding i m a b c d -> (i -> c -> m) -> a -> m-foldMapWithIndexOf l f = getConst . withIndex l (\i -> Const . f i)-{-# INLINE foldMapWithIndexOf #-}---- |--- Right-associative fold of parts of a structure that are viewed through a 'Lens', 'Getter', 'Fold' or 'Traversal'.------ > foldrWithIndexOf :: IndexedFold i a c          -> (i -> c -> e -> e) -> e -> a -> e--- > foldrWithIndexOf :: IndexedTraversal i a b c d -> (i -> c -> e -> e) -> e -> a -> e-foldrWithIndexOf :: IndexedFolding i (Endo e) a b c d -> (i -> c -> e -> e) -> e -> a -> e-foldrWithIndexOf l f z t = appEndo (foldMapWithIndexOf l (\i -> Endo . f i) t) z-{-# INLINE foldrWithIndexOf #-}----------------------------------------------------------------------------------- Indexed Traversals------------------------------------------------------------------------------------ | Every indexed traversal is a valid Traversal or indexed fold.------ The Traversal laws are still required to hold. Moreover, each index should be distinct.-type IndexedTraversal i a b c d = forall f k. (Indexed i k, Applicative f) => k (c -> f d) (a -> f b)---- | @type 'SimpleIdexedTraversal i = 'Simple' ('IndexedTraversal' i)@-type SimpleIndexedTraversal i a b = IndexedTraversal i a a b b---- |--- > traverseWithIndexOf :: IndexedTraversal i a b c d -> (i -> c -> f d) -> a -> f b-traverseWithIndexOf :: Overloaded (Index i) f a b c d -> (i -> c -> f d) -> a -> f b-traverseWithIndexOf = withIndex-{-# INLINE traverseWithIndexOf #-}---- | Map each element of a structure targeted by a lens to a monadic action,--- evaluate these actions from left to right, and collect the results, with access--- its position.------ > mapMWithIndexOf :: Monad m => IndexedTraversal a b c d -> (i -> c -> m d) -> a -> m b-mapMWithIndexOf :: Overloaded (Index i) (WrappedMonad m) a b c d -> (i -> c -> m d) -> a -> m b-mapMWithIndexOf l f = unwrapMonad . withIndex l (\i -> WrapMonad . f i)-{-# INLINE mapMWithIndexOf #-}--{--traverseList :: IndexedTraversal Int [a] [b] a b-traverseList = index $ go (0::Int) where-  go n f (x:xs) = (:) <$> f n x <*> go (n + 1) f xs-  go _ _ [] = pure []- {-# INLINE traverseList #-}--}+-- > import Control.Lens+-- > data Foo a = Foo { _fooArgs :: [String], _fooValue :: a }+-- > makeLenses ''Foo+--+-- This defines the following lenses:+--+-- > fooArgs :: Simple Lens (Foo a) [String]+-- > fooValue :: Lens (Foo a) (Foo b) a b+--+-- The combinators here have unusually specific type signatures, so for+-- particularly tricky ones, I've tried to list the simpler type signatures+-- you might want to pretend the combinators have.+----------------------------------------------------------------------------+module Control.Lens+  ( module Control.Lens.Type+  , module Control.Lens.Traversal+  , module Control.Lens.Getter+  , module Control.Lens.Setter+  , module Control.Lens.Fold+  , module Control.Lens.Iso+  , module Control.Lens.Indexed+  , module Control.Lens.Representable+  , module Control.Lens.TH+  ) where++import Control.Lens.Type+import Control.Lens.Traversal+import Control.Lens.Getter+import Control.Lens.Setter+import Control.Lens.Fold+import Control.Lens.Iso+import Control.Lens.Indexed+import Control.Lens.Representable+import Control.Lens.TH
+ src/Control/Lens/Fold.hs view
@@ -0,0 +1,763 @@+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LiberalTypeSynonyms #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE UndecidableInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Lens.Fold+-- Copyright   :  (C) 2012 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  Rank2Types+--+-- A @'Fold' a c@ is a generalization of something 'Foldable'. It allows you to+-- extract multiple results from a container. A 'Foldable' container can be+-- characterized by the behavior of @foldMap :: (Foldable t, Monoid m) => (c -> m) -> t c -> m@.+-- Since we want to be able to work with monomorphic containers, we generalize this signature to+-- @forall m. 'Monoid' m => (c -> m) -> a -> m@, and then decorate it with 'Const' to obtain+--+-- > type Fold a c = forall m b d. Monoid m => Getting m a b c d+--+-- Every 'Getter' is a valid 'Fold' that simply doesn't use the 'Monoid' it is passed.+--+-- Everything you can do with a 'Foldable' container, you can with with a 'Fold' and there are+-- combinators that generalize the usual 'Foldable' operations in @Control.Lens@.+----------------------------------------------------------------------------+module Control.Lens.Fold+  (+  -- * Folds+    Fold+  , Furled(..)+  -- ** Building Folds+  , folds+  , folding+  , folded+  , unfolded+  , iterated+  , filtered+  , backwards+  , repeated+  , replicated+  , cycled+  , takingWhile+  , droppingWhile+  -- ** Folding+  , foldMapOf, foldOf+  , foldrOf, foldlOf+  , toListOf+  , anyOf, allOf+  , andOf, orOf+  , productOf, sumOf+  , traverseOf_, forOf_, sequenceAOf_+  , mapMOf_, forMOf_, sequenceOf_+  , asumOf, msumOf+  , concatMapOf, concatOf+  , elemOf, notElemOf+  , lengthOf+  , nullOf+  , headOf, lastOf+  , maximumOf, minimumOf+  , maximumByOf, minimumByOf+  , findOf+  , foldrOf', foldlOf'+  , foldr1Of, foldl1Of+  , foldrMOf, foldlMOf+  ) where++import Control.Applicative as Applicative+import Control.Applicative.Backwards+import Control.Lens.Getter+import Control.Lens.Internal+import Control.Lens.Type+import Control.Monad+import Data.Foldable as Foldable+import Data.Maybe+import Data.Monoid+++--------------------------+-- Folds+--------------------------++-- | A 'Fold' describes how to retrieve multiple values in a way that can be composed+-- with other lens-like constructions.+--+-- A @'Fold' a c@ provides a structure with operations very similar to those of the 'Foldable'+-- typeclass, see 'foldMapOf' and the other 'Fold' combinators.+--+-- By convention, if there exists a 'foo' method that expects a @'Foldable' (f c)@, then there should be a+-- 'fooOf' method that takes a @'Fold' a c@ and a value of type @a@.+--+-- A 'Getter' is a legal 'Fold' that just ignores the supplied 'Monoid'+--+-- Unlike a 'Traversal' a 'Fold' is read-only. Since a 'Fold' cannot be used to write back+-- there are no lens laws that apply.+type Fold a c = forall r f b d. (Applicative f, Monoid r, Furled r f) => (c -> f d) -> a -> f b++-- | Something we can fold.+class Gettable f => Furled r f | f -> r where+  furled :: r -> f a+  unfurled :: f a -> r++instance Furled r (Accessor r) where+  furled = Accessor+  unfurled = runAccessor++instance Furled r f => Furled (Dual r) (Backwards f) where+  furled = Backwards . furled . getDual+  unfurled = Dual . unfurled . forwards++-- | Build a 'Getter' or 'Fold' from a 'foldMap'-like function.+--+-- > folds :: ((c -> r) -> a -> r) -> (c -> Accessor m d) -> a -> Const m b+folds :: Furled r f => ((c -> r) -> a -> r) -> LensLike f a b c d+folds l f = furled . l (unfurled . f)+{-# INLINE folds #-}++-- | 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'.+folding :: (Foldable f, Applicative g, Gettable g) => (a -> f c) -> LensLike g a b c d+folding afc cgd = coerce . traverse_ cgd . afc+{-# INLINE folding #-}++-- | Obtain a 'Fold' from any 'Foldable'.+--+-- > folded = folds foldMap+folded :: Foldable f => Fold (f c) c+folded = folds foldMap+{-# INLINE folded #-}++-- | Fold by repeating the input forever.+--+-- > repeat = toListOf repeated+repeated :: Fold a a+repeated f a = furled as where as = unfurled (f a) `mappend` as++-- | A fold that replicates its input @n@ times.+--+-- > replicate n = toListOf (replicated n)+replicated :: Int -> Fold a a+replicated n0 f a = furled (go n0) where+  m = unfurled (f a)+  go 0 = mempty+  go n = m `mappend` go (n - 1)+{-# INLINE replicated #-}++-- | Transform a fold into a fold that loops over its elements over and over.+--+-- > ghci> toListOf (cycled traverse) [1,2,3]+-- > [1,2,3,1,2,3,..]+cycled :: (Furled r f, Monoid r) => LensLike f a b c d -> LensLike f a b c d+cycled l f a = furled as where as = unfurled (l f a) `mappend` as++-- | Build a fold that unfolds its values from a seed.+--+-- > ghci> unfoldr = toListOf . unfolded+unfolded :: (b -> Maybe (a, b)) -> Fold b a+unfolded f g b0 = go b0 where+  go b = case f b of+    Just (a, b') -> g a *> go b'+    Nothing      -> furled mempty+{-# INLINE unfolded #-}++-- | @x ^. 'iterated' f@ Return an infinite fold of repeated applications of @f@ to @x@.+--+-- > toListOf (iterated f) a = iterate f a+iterated :: (a -> a) -> Fold a a+iterated f g a0 = go a0 where+  go a = g a *> go (f a)+{-# INLINE iterated #-}++-- | Obtain a 'Fold' by filtering a 'Lens', 'Iso', 'Getter', 'Fold' or 'Traversal'.+filtered :: (Furled r f, Monoid r) => (c -> Bool) -> LensLike f a b c d -> LensLike f a b c d+filtered p l f = l $ \c -> furled (if p c then unfurled (f c) else mempty)+{-# INLINE filtered #-}++-- | This allows you to traverse the elements of a 'Traversal' or 'Fold' in the opposite order.+--+-- Note: 'backwards' should have no impact on a 'Getter' 'Setter', 'Lens' or 'Iso'.+--+-- To change the direction of an 'Iso', use 'from'.+backwards :: LensLike (Backwards f) a b c d -> LensLike f a b c d+backwards l f = forwards . l (Backwards . f)+{-# INLINE backwards #-}++-- | Obtain a 'Fold' by taking elements from another 'Fold', 'Lens', 'Iso', 'Getter' or 'Traversal' while a predicate holds.+--+-- > takeWhile p = toListOf (takingWhile p folded)+--+-- > ghci> toList (takingWhile (<=3) folded) [1..]+-- > [1,2,3]+takingWhile :: (Monoid r, Furled r f) => (c -> Bool) -> Getting (Endo r) a b c d -> LensLike f a b c d+takingWhile p l f = furled . foldrOf l (\a r -> if p a then unfurled (f a) `mappend` r else mempty) mempty+{-# INLINE takingWhile #-}++-- | Obtain a 'Fold' by dropping elements from another 'Fold', 'Lens', 'Iso', 'Getter' or 'Traversal' while a predicate holds.+--+-- > dropWhile p = toListOf (droppingWhile p folded)+--+-- > ghci> toList (dropWhile (<=3) folded) [1..6]+-- > [4,5,6]+droppingWhile :: (Monoid r, Furled r f) => (c -> Bool) -> Getting (Endo r) a b c d -> LensLike f a b c d+droppingWhile p l f = furled . foldrOf l (\a r -> if p a then mempty else mappend r (unfurled (f a))) mempty+{-# INLINE droppingWhile #-}++--------------------------+-- Fold/Getter combinators+--------------------------++-- |+-- > foldMap = foldMapOf folded+--+-- > foldMapOf = views+--+-- > foldMapOf ::             Getter a c        -> (c -> r) -> a -> r+-- > foldMapOf :: Monoid r => Fold a c          -> (c -> r) -> a -> r+-- > foldMapOf ::             Lens a b c d      -> (c -> r) -> a -> r+-- > foldMapOf ::             Iso a b c d       -> (c -> r) -> a -> r+-- > foldMapOf :: Monoid r => Traversal a b c d -> (c -> r) -> a -> r+foldMapOf :: Getting r a b c d -> (c -> r) -> a -> r+foldMapOf l f = runAccessor . l (Accessor . f)+{-# INLINE foldMapOf #-}++-- |+-- > fold = foldOf folded+--+-- > foldOf = view+--+-- > foldOf ::             Getter a m        -> a -> m+-- > foldOf :: Monoid m => Fold a m          -> a -> m+-- > foldOf ::             Lens a b m d      -> a -> m+-- > foldOf ::             Iso a b m d       -> a -> m+-- > foldOf :: Monoid m => Traversal a b m d -> a -> m+foldOf :: Getting c a b c d -> a -> c+foldOf l = runAccessor . l Accessor+{-# INLINE foldOf #-}++-- |+-- Right-associative fold of parts of a structure that are viewed through a 'Lens', 'Getter', 'Fold' or 'Traversal'.+--+-- > foldr = foldrOf folded+--+-- > foldrOf :: Getter a c        -> (c -> e -> e) -> e -> a -> e+-- > foldrOf :: Fold a c          -> (c -> e -> e) -> e -> a -> e+-- > foldrOf :: Lens a b c d      -> (c -> e -> e) -> e -> a -> e+-- > foldrOf :: Iso a b c d       -> (c -> e -> e) -> e -> a -> e+-- > foldrOf :: Traversal a b c d -> (c -> e -> e) -> e -> a -> e+foldrOf :: Getting (Endo e) a b c d -> (c -> e -> e) -> e -> a -> e+foldrOf l f z t = appEndo (foldMapOf l (Endo . f) t) z+{-# INLINE foldrOf #-}++-- |+-- Left-associative fold of the parts of a structure that are viewed through a 'Lens', 'Getter', 'Fold' or 'Traversal'.+--+-- > foldl = foldlOf folded+--+-- > foldlOf :: Getter a c        -> (e -> c -> e) -> e -> a -> e+-- > foldlOf :: Fold a c          -> (e -> c -> e) -> e -> a -> e+-- > foldlOf :: Lens a b c d      -> (e -> c -> e) -> e -> a -> e+-- > foldlOf :: Iso a b c d       -> (e -> c -> e) -> e -> a -> e+-- > foldlOf :: Traversal a b c d -> (e -> c -> e) -> e -> a -> e+foldlOf :: Getting (Dual (Endo e)) a b c d -> (e -> c -> e) -> e -> a -> e+foldlOf l f z t = appEndo (getDual (foldMapOf l (Dual . Endo . flip f) t)) z+{-# INLINE foldlOf #-}++-- |+-- > toList = toListOf folded+--+-- > toListOf :: Getter a c        -> a -> [c]+-- > toListOf :: Fold a c          -> a -> [c]+-- > toListOf :: Lens a b c d      -> a -> [c]+-- > toListOf :: Iso a b c d       -> a -> [c]+-- > toListOf :: Traversal a b c d -> a -> [c]+toListOf :: Getting [c] a b c d -> a -> [c]+toListOf l = foldMapOf l return+{-# INLINE toListOf #-}++-- |+-- > and = andOf folded+--+-- > andOf :: Getter a Bool       -> a -> Bool+-- > andOf :: Fold a Bool         -> a -> Bool+-- > andOf :: Lens a b Bool d     -> a -> Bool+-- > andOf :: Iso a b Bool d      -> a -> Bool+-- > andOf :: Traversl a b Bool d -> a -> Bool+andOf :: Getting All a b Bool d -> a -> Bool+andOf l = getAll . foldMapOf l All+{-# INLINE andOf #-}++-- |+-- > or = orOf folded+--+-- > orOf :: Getter a Bool        -> a -> Bool+-- > orOf :: Fold a Bool          -> a -> Bool+-- > orOf :: Lens a b Bool d      -> a -> Bool+-- > orOf :: Iso a b Bool d       -> a -> Bool+-- > orOf :: Traversal a b Bool d -> a -> Bool+orOf :: Getting Any a b Bool d -> a -> Bool+orOf l = getAny . foldMapOf l Any+{-# INLINE orOf #-}++-- |+-- > any = anyOf folded+--+-- > anyOf :: Getter a c        -> (c -> Bool) -> a -> Bool+-- > anyOf :: Fold a c          -> (c -> Bool) -> a -> Bool+-- > anyOf :: Lens a b c d      -> (c -> Bool) -> a -> Bool+-- > anyOf :: Iso a b c d       -> (c -> Bool) -> a -> Bool+-- > anyOf :: Traversal a b c d -> (c -> Bool) -> a -> Bool+anyOf :: Getting Any a b c d -> (c -> Bool) -> a -> Bool+anyOf l f = getAny . foldMapOf l (Any . f)+{-# INLINE anyOf #-}++-- |+-- > all = allOf folded+--+-- > allOf :: Getter a c        -> (c -> Bool) -> a -> Bool+-- > allOf :: Fold a c          -> (c -> Bool) -> a -> Bool+-- > allOf :: Lens a b c d      -> (c -> Bool) -> a -> Bool+-- > allOf :: Iso a b c d       -> (c -> Bool) -> a -> Bool+-- > allOf :: Traversal a b c d -> (c -> Bool) -> a -> Bool+allOf :: Getting All a b c d -> (c -> Bool) -> a -> Bool+allOf l f = getAll . foldMapOf l (All . f)+{-# INLINE allOf #-}++-- |+-- > product = productOf folded+--+-- > productOf ::          Getter a c        -> a -> c+-- > productOf :: Num c => Fold a c          -> a -> c+-- > productOf ::          Lens a b c d      -> a -> c+-- > productOf ::          Iso a b c d       -> a -> c+-- > productOf :: Num c => Traversal a b c d -> a -> c+productOf :: Getting (Product c) a b c d -> a -> c+productOf l = getProduct . foldMapOf l Product+{-# INLINE productOf #-}++-- |+-- > sum = sumOf folded+--+-- > sumOf _1 :: (a, b) -> a+-- > 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 ::          Lens a b c d      -> a -> c+-- > sumOf ::          Iso a b c d       -> a -> c+-- > sumOf :: Num c => Traversal a b c d -> a -> c+sumOf :: Getting (Sum c) a b c d -> a -> c+sumOf l = getSum . foldMapOf l Sum+{-# INLINE sumOf #-}++-- |+--+-- When passed a 'Getter', 'traverseOf_' can work over a 'Functor'.+--+-- When passed a 'Fold', 'traverseOf_' requires an 'Applicative'.+--+-- > traverse_ = traverseOf_ folded+--+-- > traverseOf_ _2 :: Functor f => (c -> f e) -> (c1, c) -> f ()+-- > traverseOf_ traverseLeft :: Applicative f => (a -> f b) -> Either a c -> f ()+--+-- The rather specific signature of traverseOf_ allows it to be used as if the signature was either:+--+-- > traverseOf_ :: Functor f     => Getter a c        -> (c -> f e) -> a -> f ()+-- > traverseOf_ :: Applicative f => Fold a c          -> (c -> f e) -> a -> f ()+-- > traverseOf_ :: Functor f     => Lens a b c d      -> (c -> f e) -> a -> f ()+-- > traverseOf_ :: Functor f     => Iso a b c d       -> (c -> f e) -> a -> f ()+-- > traverseOf_ :: Applicative f => Traversal a b c d -> (c -> f e) -> a -> f ()+traverseOf_ :: Functor f => Getting (Traversed f) a b c d -> (c -> f e) -> a -> f ()+traverseOf_ l f = getTraversed . foldMapOf l (Traversed . void . f)+{-# INLINE traverseOf_ #-}++-- |+-- > 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     => Lens a b c d      -> a -> (c -> f e) -> f ()+-- > forOf_ :: Functor f     => Iso a b c d       -> a -> (c -> f e) -> f ()+-- > forOf_ :: Applicative f => Traversal a b c d -> a -> (c -> f e) -> f ()+forOf_ :: Functor f => Getting (Traversed f) a b c d -> a -> (c -> f e) -> f ()+forOf_ l a f = traverseOf_ l f a+{-# INLINE forOf_ #-}++-- |+-- > sequenceA_ = sequenceAOf_ folded+--+-- > sequenceAOf_ :: Functor f     => Getter a (f ())        -> a -> f ()+-- > sequenceAOf_ :: Applicative f => Fold a (f ())          -> a -> f ()+-- > sequenceAOf_ :: Functor f     => Lens a b (f ()) d      -> a -> f ()+-- > sequenceAOf_ :: Functor f     => Iso a b (f ()) d       -> a -> f ()+-- > sequenceAOf_ :: Applicative f => Traversal a b (f ()) d -> a -> f ()+sequenceAOf_ :: Functor f => Getting (Traversed f) a b (f ()) d -> a -> f ()+sequenceAOf_ l = getTraversed . foldMapOf l (Traversed . void)+{-# INLINE sequenceAOf_ #-}++-- |+-- > 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 => Lens a b c d      -> (c -> m e) -> a -> m ()+-- > mapMOf_ :: Monad m => Iso a b c d       -> (c -> m e) -> a -> m ()+-- > mapMOf_ :: Monad m => Traversal a b c d -> (c -> m e) -> a -> m ()+mapMOf_ :: Monad m => Getting (Sequenced m) a b c d -> (c -> m e) -> a -> m ()+mapMOf_ l f = getSequenced . foldMapOf l (Sequenced . liftM skip . f)+{-# INLINE mapMOf_ #-}++skip :: a -> ()+skip _ = ()+{-# INLINE skip #-}++-- |+-- > 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 => Lens a b c d      -> a -> (c -> m e) -> m ()+-- > forMOf_ :: Monad m => Iso a b c d       -> a -> (c -> m e) -> m ()+-- > forMOf_ :: Monad m => Traversal a b c d -> a -> (c -> m e) -> m ()+forMOf_ :: Monad m => Getting (Sequenced m) a b c d -> a -> (c -> m e) -> m ()+forMOf_ l a f = mapMOf_ l f a+{-# INLINE forMOf_ #-}++-- |+-- > sequence_ = sequenceOf_ folded+--+-- > sequenceOf_ :: Monad m => Getter a (m b)        -> a -> m ()+-- > sequenceOf_ :: Monad m => Fold a (m b)          -> a -> m ()+-- > sequenceOf_ :: Monad m => Lens a b (m b) d      -> a -> m ()+-- > sequenceOf_ :: Monad m => Iso a b (m b) d       -> a -> m ()+-- > sequenceOf_ :: Monad m => Traversal a b (m b) d -> a -> m ()+sequenceOf_ :: Monad m => Getting (Sequenced m) a b (m c) d -> a -> m ()+sequenceOf_ l = getSequenced . foldMapOf l (Sequenced . liftM skip)+{-# INLINE sequenceOf_ #-}++-- | The sum of a collection of actions, generalizing 'concatOf'.+--+-- > asum = asumOf folded+--+-- > asumOf :: Alternative f => Getter a c        -> a -> f c+-- > asumOf :: Alternative f => Fold a c          -> a -> f c+-- > asumOf :: Alternative f => Lens a b c d      -> a -> f c+-- > asumOf :: Alternative f => Iso a b c d       -> a -> f c+-- > asumOf :: Alternative f => Traversal a b c d -> a -> f c+asumOf :: Alternative f => Getting (Endo (f c)) a b (f c) d -> a -> f c+asumOf l = foldrOf l (<|>) Applicative.empty+{-# INLINE asumOf #-}++-- | The sum of a collection of actions, generalizing 'concatOf'.+--+-- > msum = msumOf folded+--+-- > msumOf :: MonadPlus m => Getter a c        -> a -> m c+-- > msumOf :: MonadPlus m => Fold a c          -> a -> m c+-- > msumOf :: MonadPlus m => Lens a b c d      -> a -> m c+-- > msumOf :: MonadPlus m => Iso a b c d       -> a -> m c+-- > msumOf :: MonadPlus m => Traversal a b c d -> a -> m c+msumOf :: MonadPlus m => Getting (Endo (m c)) a b (m c) d -> a -> m c+msumOf l = foldrOf l mplus mzero+{-# INLINE msumOf #-}++-- |+-- > elem = elemOf folded+--+-- > elemOf :: Eq c => Getter a c        -> c -> a -> Bool+-- > elemOf :: Eq c => Fold a c          -> c -> a -> Bool+-- > elemOf :: Eq c => Lens a b c d      -> c -> a -> Bool+-- > elemOf :: Eq c => Iso a b c d       -> c -> a -> Bool+-- > elemOf :: Eq c => Traversal a b c d -> c -> a -> Bool+elemOf :: Eq c => Getting Any a b c d -> c -> a -> Bool+elemOf l = anyOf l . (==)+{-# INLINE elemOf #-}++-- |+-- > notElem = notElemOf folded+--+-- > notElemOf :: Eq c => Getter a c        -> c -> a -> Bool+-- > notElemOf :: Eq c => Fold a c          -> c -> a -> Bool+-- > notElemOf :: Eq c => Iso a b c d       -> c -> a -> Bool+-- > notElemOf :: Eq c => Lens a b c d      -> c -> a -> Bool+-- > notElemOf :: Eq c => Traversal a b c d -> c -> a -> Bool+notElemOf :: Eq c => Getting All a b c d -> c -> a -> Bool+notElemOf l = allOf l . (/=)+{-# INLINE notElemOf #-}++-- |+-- > concatMap = concatMapOf folded+--+-- > concatMapOf :: Getter a c        -> (c -> [e]) -> a -> [e]+-- > concatMapOf :: Fold a c          -> (c -> [e]) -> a -> [e]+-- > concatMapOf :: Lens a b c d      -> (c -> [e]) -> a -> [e]+-- > concatMapOf :: Iso a b c d       -> (c -> [e]) -> a -> [e]+-- > concatMapOf :: Traversal a b c d -> (c -> [e]) -> a -> [e]+concatMapOf :: Getting [e] a b c d -> (c -> [e]) -> a -> [e]+concatMapOf l ces a = runAccessor (l (Accessor . ces) a)+{-# INLINE concatMapOf #-}++-- |+-- > concat = concatOf folded+--+-- > concatOf :: Getter a [e]        -> a -> [e]+-- > concatOf :: Fold a [e]          -> a -> [e]+-- > concatOf :: Iso a b [e] d       -> a -> [e]+-- > concatOf :: Lens a b [e] d      -> a -> [e]+-- > concatOf :: Traversal a b [e] d -> a -> [e]+concatOf :: Getting [e] a b [e] d -> a -> [e]+concatOf = view+{-# INLINE concatOf #-}++-- |+-- Note: this can be rather inefficient for large containers.+--+-- > length = lengthOf folded+--+-- > lengthOf _1 :: (a, b) -> Int+-- > lengthOf _1 = 1+-- > lengthOf (folded.folded) :: Foldable f => f (g a) -> Int+--+-- > lengthOf :: Getter a c        -> a -> Int+-- > lengthOf :: Fold a c          -> a -> Int+-- > lengthOf :: Lens a b c d      -> a -> Int+-- > lengthOf :: Iso a b c d       -> a -> Int+-- > lengthOf :: Traversal a b c d -> a -> Int+lengthOf :: Getting (Sum Int) a b c d -> a -> Int+lengthOf l = getSum . foldMapOf l (\_ -> Sum 1)+{-# INLINE lengthOf #-}++-- | Perform a safe 'head' of a 'Fold' or 'Traversal' or retrieve 'Just' the result+-- from a 'Getter' or 'Lens'.+--+-- > listToMaybe . toList = headOf folded+--+-- > headOf :: Getter a c        -> a -> Maybe c+-- > headOf :: Fold a c          -> a -> Maybe c+-- > headOf :: Lens a b c d      -> a -> Maybe c+-- > headOf :: Iso a b c d       -> a -> Maybe c+-- > headOf :: Traversal a b c d -> a -> Maybe c+headOf :: Getting (First c) a b c d -> a -> Maybe c+headOf l = getFirst . foldMapOf l (First . Just)+{-# INLINE headOf #-}++-- | Perform a safe 'last' of a 'Fold' or '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 :: Lens a b c d      -> a -> Maybe c+-- > lastOf :: Iso a b c d       -> a -> Maybe c+-- > lastOf :: Traversal a b c d -> a -> Maybe c+lastOf :: Getting (Last c) a b c d -> a -> Maybe c+lastOf l = getLast . foldMapOf l (Last . Just)+{-# INLINE lastOf #-}++-- |+-- Returns 'True' if this 'Fold' or 'Traversal' has no targets in the given container.+--+-- Note: nullOf on a valid 'Iso', 'Lens' or 'Getter' should always return 'False'+--+-- > null = nullOf folded+--+-- This may be rather inefficient compared to the 'null' check of many containers.+--+-- > nullOf _1 :: (a, b) -> Int+-- > nullOf _1 = False+-- > nullOf (folded._1.folded) :: Foldable f => f (g a, b) -> Bool+--+-- > nullOf :: Getter a c        -> a -> Bool+-- > nullOf :: Fold a c          -> a -> Bool+-- > nullOf :: Iso a b c d       -> a -> Bool+-- > nullOf :: Lens a b c d      -> a -> Bool+-- > nullOf :: Traversal a b c d -> a -> Bool+nullOf :: Getting All a b c d -> a -> Bool+nullOf l = getAll . foldMapOf l (\_ -> All False)+{-# INLINE nullOf #-}++-- |+-- Obtain the maximum element (if any) targeted by a 'Fold' or 'Traversal'+--+-- Note: maximumOf on a valid 'Iso', 'Lens' or 'Getter' will always return 'Just' a value.+--+-- > maximum = fromMaybe (error "empty") . maximumOf folded+--+-- > maximumOf ::          Getter a c        -> a -> Maybe c+-- > maximumOf :: Ord c => Fold a c          -> a -> Maybe c+-- > maximumOf ::          Iso a b c d       -> a -> Maybe c+-- > maximumOf ::          Lens a b c d      -> a -> Maybe c+-- > maximumOf :: Ord c => Traversal a b c d -> a -> Maybe c+maximumOf :: Getting (Max c) a b c d -> a -> Maybe c+maximumOf l = getMax . foldMapOf l Max+{-# INLINE maximumOf #-}++-- |+-- Obtain the minimum element (if any) targeted by a 'Fold' or 'Traversal'+--+-- Note: minimumOf on a valid 'Iso', 'Lens' or 'Getter' will always return 'Just' a value.+--+-- > minimum = fromMaybe (error "empty") . minimumOf folded+--+-- > minimumOf ::          Getter a c        -> a -> Maybe c+-- > minimumOf :: Ord c => Fold a c          -> a -> Maybe c+-- > minimumOf ::          Iso a b c d       -> a -> Maybe c+-- > minimumOf ::          Lens a b c d      -> a -> Maybe c+-- > minimumOf :: Ord c => Traversal a b c d -> a -> Maybe c+minimumOf :: Getting (Min c) a b c d -> a -> Maybe c+minimumOf l = getMin . foldMapOf l Min+{-# INLINE minimumOf #-}++-- |+-- Obtain the maximum element (if any) targeted by a 'Fold', 'Traversal', 'Lens', 'Iso',+-- or 'Getter' according to a user supplied ordering.+--+-- > maximumBy cmp = 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 :: Iso a b c d       -> (c -> c -> Ordering) -> a -> Maybe c+-- > maximumByOf :: Lens a b c d      -> (c -> c -> Ordering) -> a -> Maybe c+-- > maximumByOf :: Traversal a b c d -> (c -> c -> Ordering) -> a -> Maybe c+maximumByOf :: Getting (Endo (Maybe c)) a b c d -> (c -> c -> Ordering) -> a -> Maybe c+maximumByOf l cmp = foldrOf l step Nothing where+  step a Nothing  = Just a+  step a (Just b) = Just (if cmp a b == GT then a else b)+{-# INLINE maximumByOf #-}++-- |+-- Obtain the minimum element (if any) targeted by a 'Fold', 'Traversal', 'Lens', 'Iso'+-- or 'Getter' according to a user supplied ordering.+--+-- > 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 :: Iso a b c d       -> (c -> c -> Ordering) -> a -> Maybe c+-- > minimumByOf :: Lens a b c d      -> (c -> c -> Ordering) -> a -> Maybe c+-- > minimumByOf :: Traversal a b c d -> (c -> c -> Ordering) -> a -> Maybe c+minimumByOf :: Getting (Endo (Maybe c)) a b c d -> (c -> c -> Ordering) -> a -> Maybe c+minimumByOf l cmp = foldrOf l step Nothing where+  step a Nothing  = Just a+  step a (Just b) = Just (if cmp a b == GT then b else a)+{-# INLINE minimumByOf #-}++-- | The 'findOf' function takes a lens (or , getter, iso, fold, or traversal),+-- a predicate and a structure and returns the leftmost element of the structure+-- 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 :: Iso a b c d       -> (c -> Bool) -> a -> Maybe c+-- > findOf :: Lens a b c d      -> (c -> Bool) -> a -> Maybe c+-- > findOf :: Traversal a b c d -> (c -> Bool) -> a -> Maybe c+findOf :: Getting (First c) a b c d -> (c -> Bool) -> a -> Maybe c+findOf l p = getFirst . foldMapOf l step where+  step c+    | p c       = First (Just c)+    | otherwise = First Nothing+{-# INLINE findOf #-}++-- |+-- A variant of 'foldrOf' that has no base case and thus may only be applied+-- to lenses and structures such that the lens views at least one element of+-- the structure.+--+-- > foldr1Of l f = Prelude.foldr1 f . toListOf l+--+-- > foldr1 = foldr1Of folded+--+-- > foldr1Of :: Getter a c        -> (c -> c -> c) -> a -> c+-- > foldr1Of :: Fold a c          -> (c -> c -> c) -> a -> c+-- > foldr1Of :: Iso a b c d       -> (c -> c -> c) -> a -> c+-- > foldr1Of :: Lens a b c d      -> (c -> c -> c) -> a -> c+-- > foldr1Of :: Traversal a b c d -> (c -> c -> c) -> a -> c+foldr1Of :: Getting (Endo (Maybe c)) a b c d -> (c -> c -> c) -> a -> c+foldr1Of l f xs = fromMaybe (error "foldr1Of: empty structure")+                            (foldrOf l mf Nothing xs) where+  mf x Nothing = Just x+  mf x (Just y) = Just (f x y)+{-# INLINE foldr1Of #-}++-- | A variant of 'foldlOf' that has no base case and thus may only be applied to lenses and strutures such+-- that the lens views at least one element of the structure.+--+-- > foldl1Of l f = Prelude.foldl1Of l f . toList+--+-- > foldl1 = foldl1Of folded+--+-- > foldl1Of :: Getter a c        -> (c -> c -> c) -> a -> c+-- > foldl1Of :: Fold a c          -> (c -> c -> c) -> a -> c+-- > foldl1Of :: Iso a b c d       -> (c -> c -> c) -> a -> c+-- > foldl1Of :: Lens a b c d      -> (c -> c -> c) -> a -> c+-- > foldl1Of :: Traversal a b c d -> (c -> c -> c) -> a -> c+foldl1Of :: Getting (Dual (Endo (Maybe c))) a b c d -> (c -> c -> c) -> a -> c+foldl1Of l f xs = fromMaybe (error "foldl1Of: empty structure") (foldlOf l mf Nothing xs) where+  mf Nothing y = Just y+  mf (Just x) y = Just (f x y)+{-# INLINE foldl1Of #-}++-- | Strictly fold right over the elements of a structure.+--+-- > foldr' = foldrOf' folded+--+-- > foldrOf' :: Getter a c        -> (c -> e -> e) -> e -> a -> e+-- > foldrOf' :: Fold a c          -> (c -> e -> e) -> e -> a -> e+-- > foldrOf' :: Iso a b c d       -> (c -> e -> e) -> e -> a -> e+-- > foldrOf' :: Lens a b c d      -> (c -> e -> e) -> e -> a -> e+-- > foldrOf' :: Traversal a b c d -> (c -> e -> e) -> e -> a -> e+foldrOf' :: Getting (Dual (Endo (e -> e))) a b c d -> (c -> e -> e) -> e -> a -> e+foldrOf' l f z0 xs = foldlOf l f' id xs z0+  where f' k x z = k $! f x z+{-# INLINE foldrOf' #-}++-- | Fold over the elements of a structure, associating to the left, but strictly.+--+-- > foldl' = foldlOf' folded+--+-- > foldlOf' :: Getter a c          -> (e -> c -> e) -> e -> a -> e+-- > foldlOf' :: Fold a c            -> (e -> c -> e) -> e -> a -> e+-- > foldlOf' :: Iso a b c d         -> (e -> c -> e) -> e -> a -> e+-- > foldlOf' :: Lens a b c d        -> (e -> c -> e) -> e -> a -> e+-- > foldlOf' :: Traversal a b c d   -> (e -> c -> e) -> e -> a -> e+foldlOf' :: Getting (Endo (e -> e)) a b c d -> (e -> c -> e) -> e -> a -> e+foldlOf' l f z0 xs = foldrOf l f' id xs z0+  where f' x k z = k $! f z x+{-# INLINE foldlOf' #-}++-- | Monadic fold over the elements of a structure, associating to the right,+-- i.e. from right to left.+--+-- > 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 => Iso a b c d       -> (c -> e -> m e) -> e -> a -> m e+-- > foldrMOf :: Monad m => Lens a b c d      -> (c -> e -> m e) -> e -> a -> m e+-- > foldrMOf :: Monad m => Traversal a b c d -> (c -> e -> m e) -> e -> a -> m e+foldrMOf :: Monad m+         => Getting (Dual (Endo (e -> m e))) a b c d+         -> (c -> e -> m e) -> e -> a -> m e+foldrMOf l f z0 xs = foldlOf l f' return xs z0+  where f' k x z = f x z >>= k+{-# INLINE foldrMOf #-}++-- | Monadic fold over the elements of a structure, associating to the left,+-- i.e. from left to right.+--+-- > 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 => Iso a b c d       -> (e -> c -> m e) -> e -> a -> m e+-- > foldlMOf :: Monad m => Lens a b c d      -> (e -> c -> m e) -> e -> a -> m e+-- > foldlMOf :: Monad m => Traversal a b c d -> (e -> c -> m e) -> e -> a -> m e+foldlMOf :: Monad m+         => Getting (Endo (e -> m e)) a b c d+         -> (e -> c -> m e) -> e -> a -> m e+foldlMOf l f z0 xs = foldrOf l f' return xs z0+  where f' x k z = f z x >>= k+{-# INLINE foldlMOf #-}
+ src/Control/Lens/Getter.hs view
@@ -0,0 +1,279 @@+{-# LANGUAGE Rank2Types #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Lens.Getter+-- Copyright   :  (C) 2012 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  Rank2Types+--+--+-- A @'Getter' a c@ is just any function @(a -> c)@, which we've flipped into continuation+-- passing style, @(c -> r) -> a -> r@ and decorated with 'Accessor' to obtain+--+-- > type Getting r a b c d = (c -> Accessor r d) -> a -> Accessor r b+--+-- If we restrict access to knowledge about the type 'r' and can work for any d and b, we could get:+--+-- > type Getter a c = forall r b d. Getting r a b c d+--+-- But we actually hide the use of 'Accessor' behind a class 'Gettable' to error messages from+-- type class resolution rather than at unification time, where they are much uglier.+-- type Getter a c = forall f b d. Gettable f => (c -> f d) -> a -> f b+--+-- Everything you can do with a function, you can do with a 'Getter', but note that because of the+-- continuation passing style @(.)@ composes them in the opposite order.+--+-- Since it is only a function, every 'Getter' obviously only retrieves a single value for a given+-- input.+--+----------------------------------------------------------------------------+module Control.Lens.Getter+  (+  -- * Getters+    Getter+  , Getting+  , Gettable(..)+  , Accessor(..)+  -- * Building Getters+  , to+  -- * Combinators for Getters and Folds+  , (^.), (^$)+  , view+  , views+  , use+  , uses+  , query+  , queries+  ) where++import Control.Applicative+import Control.Applicative.Backwards+import Control.Lens.Internal+import Control.Monad.Reader.Class       as Reader+import Control.Monad.State.Class        as State+import Data.Complex -- for tests+import Data.Functor.Compose+import Data.Monoid+import Control.Lens.Type -- for tests++infixl 8 ^.+infixr 0 ^$++---------------+-- Getters+---------------++-- | A 'Getter' describes how to retrieve a single value in a way that can be composed with+-- other lens-like constructions.+--+-- Unlike a 'Lens' a 'Getter' is read-only. Since a 'Getter' cannot be used to write back+-- there are no lens laws that can be applied to it.+--+-- Moreover, a 'Getter' can be used directly as a 'Fold', since it just ignores the 'Monoid'.+type Getter a c = forall f b d. Gettable f => (c -> f d) -> a -> f b++-- | Build a 'Getter' from an arbitrary Haskell function.+--+-- > to f . to g = to (g . f)+-- > a^.to f = f a+--+-- >>> (0, -5)^._2.to abs+-- 5+to :: (a -> c) -> Getter a c+to f g = coerce . g . f+{-# INLINE to #-}++-- |+-- Most 'Getter' combinators are able to be used with both a 'Getter' or a 'Fold' in+-- limited situations, to do so, they need to be monomorphic in what we are going to+-- extract with 'Const'. To be compatible with 'Lens', 'Traversal' and 'Iso' we also+-- restricted choices of the irrelevant b and d parameters.+--+-- If a function accepts a @Getting m r a b c d@, then when @r@ is a Monoid, and @m@ is a+-- 'Monad' you can pass a 'Fold' (or 'Traversal'), otherwise you can only pass this a+-- 'Getter' or 'Lens'.+type Getting r a b c d = (c -> Accessor r d) -> a -> Accessor r b++-----------------------------------------------------------------------------+-- Gettables & Accessors+-----------------------------------------------------------------------------++-- | Generalizing Const so we can apply simple Applicative transformations to it+-- and so we can get nicer error messages+class Functor f => Gettable f where+  coerce :: f a -> f b++instance Gettable (Const r) where+  coerce (Const m) = Const m++instance Gettable f => Gettable (Backwards f) where+  coerce = Backwards . coerce . forwards++instance (Functor f, Gettable g) => Gettable (Compose f g) where+  coerce = Compose . fmap coerce . getCompose++instance Gettable f => Gettable (ElementOf f) where+  coerce (ElementOf m) = ElementOf $ \i -> case m i of+    Searching _ _ -> NotFound "coerced while searching"+    Found j as    -> Found j (coerce as)+    NotFound s    -> NotFound s++-- | Used instead of Const to report 'no instance of (Settable Accessor)' when+-- attempting to misuse a 'Setter' as a 'Getter'.+newtype Accessor r a = Accessor { runAccessor :: r }++instance Functor (Accessor r) where+  fmap _ (Accessor m) = Accessor m++instance Gettable (Accessor r) where+  coerce (Accessor m) = Accessor m++instance Monoid r => Applicative (Accessor r) where+  pure _ = Accessor mempty+  Accessor a <*> Accessor b = Accessor (mappend a b)++-------------------------------+-- Getting Values+-------------------------------++-- | View the value pointed to by a 'Getter', 'Iso' or 'Lens' or the result of folding over+-- all the results of a 'Fold' or 'Traversal' that points at a monoidal values.+--+-- It may be useful to think of 'view' as having these more restrictive signatures:+--+-- > view . to = id+--+-- >>> view _2 (1,"hello")+-- "hello"+--+-- > view ::             Getter a c          -> a -> c+-- > view :: Monoid m => Fold a m            -> a -> m+-- > view ::             Iso a b c d         -> a -> c+-- > view ::             Lens a b c d        -> a -> c+-- > view :: Monoid m => Traversal a b m d   -> a -> m+view :: Getting c a b c d -> a -> c+view l = runAccessor . l Accessor+{-# INLINE view #-}++-- | View the value of a 'Getter', 'Iso', 'Lens' or the result of folding over the+-- result of mapping the targets of a 'Fold' or 'Traversal'.+--+-- It may be useful to think of 'views' as having these more restrictive signatures:+--+-- >>> views _2 length (1,"hello")+-- 5+--+-- > views ::             Getter a c          -> (c -> d) -> a -> d+-- > views :: Monoid m => Fold a c            -> (c -> m) -> a -> m+-- > views ::             Iso a b c d         -> (c -> d) -> a -> d+-- > views ::             Lens a b c d        -> (c -> d) -> a -> d+-- > views :: Monoid m => Traversal a b c d   -> (c -> m) -> a -> m+views :: Getting m a b c d -> (c -> m) -> a -> m+views l f = runAccessor . l (Accessor . f)+{-# INLINE views #-}++-- | View the value pointed to by a 'Getter', 'Iso' or 'Lens' or the result of folding over+-- all the results of a 'Fold' or 'Traversal' that points at a monoidal values.+--+-- This is the same operation as 'view', only infix.+--+-- >>> _2 ^$ (1, "hello")+-- "hello"+--+-- > (^$) ::             Getter a c          -> a -> c+-- > (^$) :: Monoid m => Fold a m            -> a -> m+-- > (^$) ::             Iso a b c d         -> a -> c+-- > (^$) ::             Lens a b c d        -> a -> c+-- > (^$) :: Monoid m => Traversal a b m d   -> a -> m+(^$) :: Getting c a b c d -> a -> c+l ^$ a = runAccessor (l Accessor a)+{-# INLINE (^$) #-}++-- | View the value pointed to by a 'Getter' or 'Lens' or the result of folding over+-- all the results of a 'Fold' or 'Traversal' that points at a monoidal values.+--+-- This is the same operation as 'view' with the arguments flipped.+--+-- The fixity and semantics are such that subsequent field accesses can be+-- performed with (Prelude..)+--+-- >>> ((0, 1 :+ 2), 3)^._1._2.to magnitude+-- 2.23606797749979+--+-- > (^.) ::             a -> Getter a c          -> c+-- > (^.) :: Monoid m => a -> Fold a m            -> m+-- > (^.) ::             a -> Iso a b c d         -> c+-- > (^.) ::             a -> Lens a b c d        -> c+-- > (^.) :: Monoid m => a -> Traversal a b m d   -> m+(^.) :: a -> Getting c a b c d -> c+a ^. l = runAccessor (l Accessor a)+{-# INLINE (^.) #-}++------------------------------------------------------------------------------+-- MonadReader+------------------------------------------------------------------------------++-- |+-- Query the target of a 'Lens', 'Iso' or 'Getter' in the current state, or use a+-- summary of a 'Fold' or 'Traversal' that points to a monoidal value.+--+-- > query :: MonadReader a m             => Getter a c        -> m c+-- > query :: (MonadReader a m, Monoid c) => Fold a c          -> m c+-- > query :: MonadReader a m             => Iso a b c d       -> m c+-- > query :: MonadReader a m             => Lens a b c d      -> m c+-- > query :: (MonadReader a m, Monoid c) => Traversal a b c d -> m c+--+-- > query :: MonadReader a m => ((c -> Const c d) -> a -> Const c b) -> m c+query :: MonadReader a m => Getting c a b c d -> m c+query l = Reader.asks (^.l)+{-# INLINE query #-}++-- |+-- Use the target of a 'Lens', 'Iso' or 'Getter' in the current state, or use a+-- summary of a 'Fold' or 'Traversal' that points to a monoidal value.+--+-- > queries :: MonadReader a m             => Getter a c        -> (c -> e) -> m e+-- > queries :: (MonadReader a m, Monoid c) => Fold a c          -> (c -> e) -> m e+-- > queries :: MonadReader a m             => Iso a b c d       -> (c -> e) -> m e+-- > queries :: MonadReader a m             => Lens a b c d      -> (c -> e) -> m e+-- > queries :: (MonadReader a m, Monoid c) => Traversal a b c d -> (c -> e) -> m e+--+-- > queries :: MonadReader a m => ((c -> Const e d) -> a -> Const e b) -> (c -> e) -> m e+queries :: MonadReader a m => Getting e a b c d -> (c -> e) -> m e+queries l f = Reader.asks (views l f)+{-# INLINE queries #-}++------------------------------------------------------------------------------+-- MonadState+------------------------------------------------------------------------------++-- |+-- Use the target of a 'Lens', 'Iso', or 'Getter' in the current state, or use a+-- summary of a 'Fold' or 'Traversal' that points to a monoidal value.+--+-- > use :: MonadState a m             => Action m a b      -> m b+-- > use :: MonadState a m             => Getter a c        -> m c+-- > use :: (MonadState a m, Monoid r) => Fold a r          -> m r+-- > use :: MonadState a m             => Iso a b c d       -> m c+-- > use :: MonadState a m             => Lens a b c d      -> m c+-- > use :: (MonadState a m, Monoid r) => Traversal a b r d -> m r+use :: MonadState a m => Getting c a b c d -> m c+use l = State.gets (view l)+{-# INLINE use #-}++-- |+-- Use the target of a 'Lens', 'Iso' or 'Getter' in the current state, or use a+-- summary of a 'Fold' or 'Traversal' that points to a monoidal value.+--+-- > uses :: MonadState a m             => Action m a c      -> (c -> e) -> m e+-- > uses :: MonadState a m             => Getter a c        -> (c -> e) -> m e+-- > uses :: (MonadState a m, Monoid r) => Fold a c          -> (c -> r) -> m r+-- > uses :: MonadState a m             => Lens a b c d      -> (c -> e) -> m e+-- > uses :: MonadState a m             => Iso a b c d       -> (c -> e) -> m e+-- > uses :: (MonadState a m, Monoid r) => Traversal a b c d -> (c -> r) -> m r+uses :: MonadState a m => Getting e a b c d -> (c -> e) -> m e+uses l f = State.gets (views l f)+{-# INLINE uses #-}
+ src/Control/Lens/Indexed.hs view
@@ -0,0 +1,168 @@+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Lens.Indexed+-- Copyright   :  (C) 2012 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  rank 2 types, MPTCs, TFs, flexible+--+----------------------------------------------------------------------------+module Control.Lens.Indexed+  (+  -- * Indexed Functions+    Indexed(..)+  , Indexable+  , Index(..)+  , (.@)+  , composeWithIndex+  , reindex++  -- * Indexed Folds+  , IndexedFold+  , foldMapWithIndexOf+  , foldrWithIndexOf++  -- * Indexed Traversals+  , IndexedTraversal+  , traverseWithIndexOf+  , mapMWithIndexOf++  -- * Indexed Setter+  , IndexedSetter+  , mapWithIndexOf+  , (%@)++  -- * Simple+  , SimpleIndexedTraversal+  , SimpleIndexedSetter+  ) where++import Control.Applicative+import Control.Lens.Type+import Control.Lens.Getter+import Control.Lens.Setter+import Data.Monoid++-- | Permit overloading of function application for things that also admit a notion of a key or index.++-- | Provides overloading for indexed functions.+class Indexed i k where+  -- | Build a function from an indexed function+  index :: ((i -> a) -> b) -> k a b++-- | Type alias for passing around polymorphic indexed functions.+type Indexable i a b = forall k. Indexed i k => k a b++instance Indexed i (->) where+  index f = f . const+  {-# INLINE index #-}++-- | A function with access to a index. This constructor may be useful when you need to store+-- a 'HasIndex'.+newtype Index i a b = Index { withIndex :: (i -> a) -> b }++-- | Using an equality witness to avoid potential overlapping instances+-- and aid dispatch.+instance i ~ j => Indexed i (Index j) where+  index = Index+  {-# INLINE index #-}++-- | Remap the index.+reindex :: Indexed j k => (i -> j) -> Index i a b -> k a b+reindex ij (Index iab) = index $ \ ja -> iab $ \i -> ja (ij i)+{-# SPECIALIZE reindex :: (i -> j) -> Index i a b -> Index j a b #-}+{-# SPECIALIZE reindex :: (i -> j) -> Index i a b -> a -> b #-}++infixr 9 .@+-- | Composition of indexed functions+(.@) :: Indexed (i, j) k => Index i b c -> Index j a b -> k a c+f .@ g = composeWithIndex (,) f g+{-# INLINE (.@) #-}+{-# SPECIALIZE (.@) :: Index i b c -> Index j a b -> Index (i,j) a c #-}+{-# SPECIALIZE (.@) :: Index i b c -> Index j a b -> a -> c #-}++-- | Composition of indexed functions with a user supplied function for combining indexs+composeWithIndex :: Indexed k r => (i -> j -> k) -> Index i b c -> Index j a b -> r a c+composeWithIndex ijk (Index ibc) (Index jab) = index $ \ka -> ibc $ \i -> jab $ \j -> ka (ijk i j)+{-# INLINE composeWithIndex #-}+{-# SPECIALIZE composeWithIndex :: (i -> j -> k) -> Index i b c -> Index j a b -> a -> c #-}++------------------------------------------------------------------------------+-- Indexed Folds+------------------------------------------------------------------------------++-- | Every 'IndexedFold' is a valid 'Fold'.+type IndexedFold i a c = forall k f b d. (Indexed i k, Applicative f, Gettable f) => k (c -> f d) (a -> f b)++type IndexedFolding i m a b c d = Index i (c -> Accessor m d) (a -> Accessor m b)++-- |+--+-- > foldMapWithIndexOf :: Monoid m => IndexedFold i a c          -> (i -> c -> m) -> a -> m+-- > foldMapWithIndexOf :: Monoid m => IndexedTraversal i a b c d -> (i -> c -> m) -> a -> m+foldMapWithIndexOf :: IndexedFolding i m a b c d -> (i -> c -> m) -> a -> m+foldMapWithIndexOf l f = runAccessor . withIndex l (\i -> Accessor . f i)+{-# INLINE foldMapWithIndexOf #-}++-- |+-- Right-associative fold of parts of a structure that are viewed through a 'Lens', 'Getter', 'Fold' or 'Traversal'.+--+-- > foldrWithIndexOf :: IndexedFold i a c          -> (i -> c -> e -> e) -> e -> a -> e+-- > foldrWithIndexOf :: IndexedTraversal i a b c d -> (i -> c -> e -> e) -> e -> a -> e+foldrWithIndexOf :: IndexedFolding i (Endo e) a b c d -> (i -> c -> e -> e) -> e -> a -> e+foldrWithIndexOf l f z t = appEndo (foldMapWithIndexOf l (\i -> Endo . f i) t) z+{-# INLINE foldrWithIndexOf #-}++------------------------------------------------------------------------------+-- Indexed Traversals+------------------------------------------------------------------------------++-- | Every indexed traversal is a valid Traversal or indexed fold.+--+-- The Traversal laws are still required to hold.+type IndexedTraversal i a b c d = forall f k. (Indexed i k, Applicative f) => k (c -> f d) (a -> f b)++-- | @type 'SimpleIdexedTraversal i = 'Simple' ('IndexedTraversal' i)@+type SimpleIndexedTraversal i a b = IndexedTraversal i a a b b++-- |+-- > traverseWithIndexOf :: IndexedTraversal i a b c d -> (i -> c -> f d) -> a -> f b+traverseWithIndexOf :: Overloaded (Index i) f a b c d -> (i -> c -> f d) -> a -> f b+traverseWithIndexOf = withIndex+{-# INLINE traverseWithIndexOf #-}++-- | Map each element of a structure targeted by a lens to a monadic action,+-- evaluate these actions from left to right, and collect the results, with access+-- its position.+--+-- > mapMWithIndexOf :: Monad m => IndexedTraversal a b c d -> (i -> c -> m d) -> a -> m b+mapMWithIndexOf :: Overloaded (Index i) (WrappedMonad m) a b c d -> (i -> c -> m d) -> a -> m b+mapMWithIndexOf l f = unwrapMonad . withIndex l (\i -> WrapMonad . f i)+{-# INLINE mapMWithIndexOf #-}++-- | Every indexed Setter is a valid Setter+--+-- The 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)++-- | @type 'SimpleIdexedTraversal i = 'Simple' ('IndexedTraversal' i)@+type SimpleIndexedSetter i a b = IndexedSetter i a a b b++-- | Map with index+--+-- > mapWithIndexOf :: IndexedSetter i a b c d -> (i -> c -> d) -> a -> b+mapWithIndexOf :: Overloaded (Index i) Mutator a b c d -> (i -> c -> d) -> a -> b+mapWithIndexOf l f = runMutator . withIndex l (\i -> Mutator . f i)++infixr 4 %@++-- | > (%@) = mapWithIndexOf+(%@) :: Overloaded (Index i) Mutator a b c d -> (i -> c -> d) -> a -> b+l %@ f = runMutator . withIndex l (\i -> Mutator . f i)+
src/Control/Lens/Internal.hs view
@@ -19,7 +19,7 @@     IndexedStore(..)   , Focusing(..)   , Traversed(..)-  , Action(..)+  , Sequenced(..)   , AppliedState(..)   , Min(..)   , getMin@@ -86,11 +86,11 @@   Traversed ma `mappend` Traversed mb = Traversed (ma *> mb)  -- | Used internally by 'mapM_' and the like.-newtype Action m = Action { getAction :: m () }+newtype Sequenced m = Sequenced { getSequenced :: m () } -instance Monad m => Monoid (Action m) where-  mempty = Action (return ())-  Action ma `mappend` Action mb = Action (ma >> mb)+instance Monad m => Monoid (Sequenced m) where+  mempty = Sequenced (return ())+  Sequenced ma `mappend` Sequenced mb = Sequenced (ma >> mb)  -- | Used for 'minimumOf' data Min a = NoMin | Min a@@ -124,10 +124,12 @@ data ElementOfResult f a   = Searching {-# UNPACK #-} !Int a   | Found {-# UNPACK #-} !Int (f a)+  | NotFound String  instance Functor f => Functor (ElementOfResult f) where   fmap f (Searching i a) = Searching i (f a)   fmap f (Found i as) = Found i (fmap f as)+  fmap _ (NotFound e) = NotFound e  -- | Used to find the nth element of a 'Traversal'. data ElementOf f a = ElementOf { getElementOf :: Int -> ElementOfResult f a }@@ -135,15 +137,18 @@ instance Functor f => Functor (ElementOf f) where   fmap f (ElementOf m) = ElementOf $ \i -> case m i of     Searching j a -> Searching j (f a)-    Found j as -> Found j (fmap f as)+    Found j as    -> Found j (fmap f as)+    NotFound e    -> NotFound e  instance Functor f => Applicative (ElementOf f) where   pure a = ElementOf $ \i -> Searching i a   ElementOf mf <*> ElementOf ma = ElementOf $ \i -> case mf i of     Found j ff -> case ma j of-      Found _ _ -> error "elementOf: found multiple results"+      Found _ _     -> NotFound "multiple results"       Searching k a -> Found k (fmap ($a) ff)+      NotFound e    -> NotFound e     Searching j f -> case ma j of-      Found k as -> Found k (fmap f as)+      Found k as    -> Found k (fmap f as)       Searching k a -> Searching k (f a)-+      NotFound e    -> NotFound e+    NotFound e -> NotFound e
+ src/Control/Lens/Iso.hs view
@@ -0,0 +1,160 @@+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE DeriveDataTypeable #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Lens.Iso+-- Copyright   :  (C) 2012 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  Rank2Types+--+----------------------------------------------------------------------------+module Control.Lens.Iso+  (+  -- * Isomorphisms+    Isomorphic(..)+  , Isomorphism(..)+  , iso+  , isos+  , from+  , via+  , Iso+  , SimpleIso+  , _const+  , identity+  ) where++import Control.Applicative+import Control.Category+import Data.Functor.Identity+import Data.Typeable+import Prelude hiding ((.),id)++----------------------------------------------------------------------------+-- Isomorphism Implementation Details+-----------------------------------------------------------------------------++-- | Used to provide overloading of isomorphism application+--+-- This is a 'Category' with a canonical mapping to it from the+-- category of isomorphisms over Haskell types.+class Category k => Isomorphic k where+  -- | Build this morphism out of an isomorphism+  --+  -- The intention is that by using 'isomorphic', you can supply both halves of an+  -- isomorphism, but k can be instantiated to (->), so you can freely use+  -- the resulting isomorphism as a function.+  isomorphic :: (a -> b) -> (b -> a) -> k a b++  -- | Map a morphism in the target category using an isomorphism between morphisms+  -- in Hask.+  isomap :: ((a -> b) -> c -> d) -> ((b -> a) -> d -> c) -> k a b -> k c d++instance Isomorphic (->) where+  isomorphic = const+  {-# INLINE isomorphic #-}+  isomap = const+  {-# INLINE isomap #-}++-- | A concrete data type for isomorphisms.+--+-- This lets you place an isomorphism inside a container without using @ImpredicativeTypes@.+data Isomorphism a b = Isomorphism (a -> b) (b -> a)+  deriving Typeable++instance Category Isomorphism where+  id = Isomorphism id id+  {-# INLINE id #-}+  Isomorphism bc cb . Isomorphism ab ba = Isomorphism (bc . ab) (ba . cb)+  {-# INLINE (.) #-}++instance Isomorphic Isomorphism where+  isomorphic = Isomorphism+  {-# INLINE isomorphic #-}+  isomap abcd badc (Isomorphism ab ba) = Isomorphism (abcd ab) (badc ba)+  {-# INLINE isomap #-}++-- | Invert an isomorphism.+--+-- Note to compose an isomorphism and receive an isomorphism in turn you'll need to use+-- 'Control.Category.Category'+--+-- > from (from l) = l+--+-- If you imported 'Control.Category.(.)', then:+--+-- > from l . from r = from (r . l)+--+-- > from :: (a :~> b) -> (b :~> a)+from :: Isomorphic k => Isomorphism a b -> k b a+from (Isomorphism a b) = isomorphic b a+{-# INLINE from #-}+{-# SPECIALIZE from :: Isomorphism a b -> b -> a #-}+{-# SPECIALIZE from :: Isomorphism a b -> Isomorphism b a #-}++-- |+-- > via :: Isomorphism a b -> (a :~> b)+via :: Isomorphic k => Isomorphism a b -> k a b+via (Isomorphism a b) = isomorphic a b+{-# INLINE via #-}+{-# SPECIALIZE via :: Isomorphism a b -> a -> b #-}+{-# SPECIALIZE via :: Isomorphism a b -> Isomorphism a b #-}++-----------------------------------------------------------------------------+-- Isomorphisms families as Lenses+-----------------------------------------------------------------------------++-- | Isomorphim families can be composed with other lenses using either' (.)' and 'id'+-- from the Prelude or from Control.Category. However, if you compose them+-- with each other using '(.)' from the Prelude, they will be dumbed down to a+-- mere 'Lens'.+--+-- > import Control.Category+-- > import Prelude hiding ((.),id)+--+-- > type Iso a b c d = forall k f. (Isomorphic k, Functor f) => Overloaded k f a b c d+type Iso a b c d = forall k f. (Isomorphic k, Functor f) => k (c -> f d) (a -> f b)++-- | > type SimpleIso a b = Simple Iso a b+type SimpleIso a b = Iso a a b b++-- | Build an isomorphism family from two pairs of inverse functions+--+-- > isos :: (a -> c) -> (c -> a) -> (b -> d) -> (d -> b) -> Iso a b c d+isos :: (Isomorphic k, Functor f) => (a -> c) -> (c -> a) -> (b -> d) -> (d -> b) -> k (c -> f d) (a -> f b)+isos ac ca bd db = isomorphic+  (\cfd a -> db <$> cfd (ac a))+  (\afb c -> bd <$> afb (ca c))+{-# INLINE isos #-}+{-# SPECIALIZE isos :: Functor f => (a -> c) -> (c -> a) -> (b -> d) -> (d -> b) -> (c -> f d) -> a -> f b #-}+{-# SPECIALIZE isos :: Functor f => (a -> c) -> (c -> a) -> (b -> d) -> (d -> b) -> Isomorphism (c -> f d) (a -> f b) #-}++-- | Build a simple isomorphism from a pair of inverse functions+--+-- > iso :: (a -> b) -> (b -> a) -> Simple Iso a b+iso :: (Isomorphic k, Functor f) => (a -> b) -> (b -> a) -> k (b -> f b) (a -> f a)+iso ab ba = isos ab ba ab ba+{-# INLINE iso #-}+{-# SPECIALIZE iso :: Functor f => (a -> b) -> (b -> a) -> (b -> f b) -> a -> f a #-}+{-# SPECIALIZE iso :: Functor f => (a -> b) -> (b -> a) -> Isomorphism (b -> f b) (a -> f a) #-}++-----------------------------------------------------------------------------+-- Isomorphisms+-----------------------------------------------------------------------------++-- | This isomorphism can be used to wrap or unwrap a value in 'Identity'.+--+-- > x^.identity = Identity x+-- > Identity x^.from identity = x+identity :: Iso a b (Identity a) (Identity b)+identity = isos Identity runIdentity Identity runIdentity+{-# INLINE identity #-}++-- | This isomorphism can be used to wrap or unwrap a value in 'Const'+--+-- > x^._const = Const x+-- > Const x^.from _const = x+_const :: Iso a b (Const a c) (Const b d)+_const = isos Const getConst Const getConst+{-# INLINE _const #-}
src/Control/Lens/Representable.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE RankNTypes #-}-{-# LANGUAGE TypeOperators #-} ----------------------------------------------------------------------------- -- | -- Module      :  Control.Lens.Representable@@ -19,8 +18,6 @@ -- Consider the following example. -- -- > import Control.Lens--- > import Control.Lens.Representable--- > import Control.Lens.TH -- > import Data.Distributive -- -- > data Pair a = Pair { _x :: a, _y :: a }@@ -57,8 +54,8 @@   , bindRep   , distributeRep   -- * Wrapped Representations-  , Key(..)-  , keys+  , Path(..)+  , paths   , tabulated   -- * Traversal with representation   , mapWithRep@@ -73,8 +70,9 @@   ) where  import Control.Applicative-import Control.Isomorphic-import Control.Lens+import Control.Lens.Iso+import Control.Lens.Type+import Control.Lens.Getter import Data.Foldable         as Foldable import Data.Functor.Identity import Data.Monoid@@ -184,25 +182,25 @@ {-# INLINE distributeRep #-}  -------------------------------------------------------------------------------- Keys+-- Paths -----------------------------------------------------------------------------  -- | Sometimes you need to store a path lens into a container, but at least -- at this time, impredicative polymorphism in GHC is somewhat lacking. -- -- This type provides a way to, say, store a list of polymorphic lenses.-newtype Key f = Key { turn :: Rep f }+newtype Path f = Path { walk :: Rep f }  -- | A 'Representable' 'Functor' has a fixed shape. This fills each position--- in it with a 'Key'-keys :: Representable f => f (Key f)-keys = rep Key-{-# INLINE keys #-}+-- in it with a 'Path'+paths :: Representable f => f (Path f)+paths = rep Path+{-# INLINE paths #-}  -- | A version of 'rep' that is an isomorphism. Predicativity requires that -- we wrap the 'Rep' as a 'Key', however.-tabulated :: Representable f => (Key f -> a) :~> f a-tabulated = isomorphic (\f -> rep (f . Key)) (\fa key -> view (turn key) fa)+tabulated :: (Isomorphic k, Representable f) => k (Path f -> a) (f a)+tabulated = isomorphic (\f -> rep (f . Path)) (\fa path -> view (walk path) fa) {-# INLINE tabulated #-}  -----------------------------------------------------------------------------
+ src/Control/Lens/Setter.hs view
@@ -0,0 +1,457 @@+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE LiberalTypeSynonyms #-}+{-# OPTIONS_GHC -fno-warn-unused-binds #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Lens.Setter+-- Copyright   :  (C) 2012 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  Rank2Types+--+-- A @'Setter' a b c d@ is a generalization of 'fmap' from 'Functor'. It allows you to map into a+--  structure and change out the contents, but it isn't strong enough to allow you to+--  enumerate those contents. Starting with @fmap :: 'Functor' f => (c -> d) -> f c -> f d@+--  we monomorphize the type to obtain @(c -> d) -> a -> b@ and then decorate it with 'Identity' to obtain+--+-- > type Setter a b c d = (c -> Identity d) -> a -> Identity b+--+--  Every 'Traversal' is a valid 'Setter', since 'Identity' is 'Applicative'.+--+-- Everything you can do with a 'Functor', you can do with a 'Setter'. There+-- are combinators that generalize 'fmap' and '(<$)'.+----------------------------------------------------------------------------+module Control.Lens.Setter+  (+  -- * Setters+    Setter+  , Settable(..)+  -- * Consuming Setters+  , Setting+  , Mutator(..)+  -- * Building Setters+  , sets+  -- * Common Setters+  , mapped+  -- * Functional Combinators+  , adjust+  , mapOf+  , set+  , (.~), (%~)+  , (+~), (-~), (*~), (//~), (^~), (^^~), (**~), (||~), (&&~), (<>~)+  -- * State Combinators+  , (.=), (%=)+  , (+=), (-=), (*=), (//=), (^=), (^^=), (**=), (||=), (&&=), (<>=)+  , (<~)+  -- * MonadWriter+  , whisper+  -- * Simplicity+  , SimpleSetter+  , SimpleSetting+  ) where++import Control.Applicative+import Control.Applicative.Backwards+import Control.Monad.State.Class        as State+import Control.Monad.Writer.Class       as Writer+import Data.Functor.Compose+import Data.Functor.Identity+import Data.Monoid++infixr 4 .~, +~, *~, -~, //~, ^~, ^^~, **~, &&~, ||~, %~, <>~+infix  4 .=, +=, *=, -=, //=, ^=, ^^=, **=, &&=, ||=, %=, <>=++infixr 2 <~+++------------------------------------------------------------------------------+-- Setters+------------------------------------------------------------------------------++-- |+-- The only 'Lens'-like law that can apply to a 'Setter' @l@ is that+--+-- > set l c (set l b a) = set l c a+--+-- You can't 'view' a 'Setter' in general, so the other two laws are irrelevant.+--+-- However, two functor laws apply to a 'Setter'+--+-- > adjust l id = id+-- > adjust l f . adjust l g = adjust l (f . g)+--+-- These an be stated more directly:+--+-- > l pure = pure+-- > l f . run . l g = l (f . run . g)+--+-- You can compose a 'Setter' with a 'Lens' or a 'Traversal' using @(.)@ from the Prelude+-- and the result is always only a 'Setter' and nothing more.+type Setter a b c d = forall f. Settable f => (c -> f d) -> a -> f b++-- |+-- Running a Setter instantiates it to a concrete type.+--+-- When consuming a setter, use this type.+type Setting a b c d = (c -> Mutator d) -> a -> Mutator b++-- |+-- > 'SimpleSetter' = 'Simple' 'Setter'+type SimpleSetter a b = Setter a a b b++-- |+-- > 'SimpleSetting' m = 'Simple' 'Setting'+type SimpleSetting a b = Setting a a b b++-----------------------------------------------------------------------------+-- Settables & Mutators+-----------------------------------------------------------------------------++-- | Anything Settable must be isomorphic to the Identity Functor.+class Applicative f => Settable f where+  run :: f a -> a++instance Settable Identity where+  run = runIdentity++instance Settable f => Settable (Backwards f) where+  run = run . forwards++instance (Settable f, Settable g) => Settable (Compose f g) where+  run = run . run . getCompose++-- | 'Mutator' is just a renamed 'Identity' functor to give better error+-- messages when someone attempts to use a getter as a setter.+newtype Mutator a = Mutator { runMutator :: a }++instance Functor Mutator where+  fmap f (Mutator a) = Mutator (f a)++instance Applicative Mutator where+  pure = Mutator+  Mutator f <*> Mutator a = Mutator (f a)++instance Settable Mutator where+  run = runMutator++-----------------------------------------------------------------------------+-- Setters+-----------------------------------------------------------------------------++-- | This setter can be used to map over all of the values in a 'Functor'.+--+-- > fmap        = adjust mapped+-- > fmapDefault = adjust traverse+-- > (<$)        = set mapped+mapped :: Functor f => Setter (f a) (f b) a b+mapped = sets fmap+{-# INLINE mapped #-}++-- | Build a Setter from a map-like function.+--+-- Your supplied function @f@ is required to satisfy:+--+-- > f id = id+-- > f g . f h = f (g . h)+--+-- Equational reasoning:+--+-- > sets . adjust = id+-- > adjust . sets = id+--+-- Another way to view 'sets' is that it takes a 'semantic editor combinator'+-- and transforms it into a 'Setter'.+sets :: ((c -> d) -> a -> b) -> Setter a b c d+sets f g = pure . f (run . g)+{-# INLINE sets #-}++-----------------------------------------------------------------------------+-- Using Setters+-----------------------------------------------------------------------------++-- | Modify the target of a 'Lens' or all the targets of a 'Setter' or 'Traversal'+-- with a function.+--+-- > fmap        = adjust mapped+-- > fmapDefault = adjust traverse+--+-- > sets . adjust = id+-- > adjust . sets = id+--+-- > adjust :: Setter a b c d -> (c -> d) -> a -> b+--+-- Another way to view 'adjust' is to say that it transformers a 'Setter' into a+-- \"semantic editor combinator\".+adjust :: Setting a b c d -> (c -> d) -> a -> b+adjust l f = runMutator . l (Mutator . f)+{-# INLINE adjust #-}++-- | Modify the target of a 'Lens' or all the targets of a 'Setter' or 'Traversal'+-- with a function. This is an alias for adjust that is provided for consistency.+--+-- > mapOf = adjust+--+-- > fmap        = mapOf mapped+-- > fmapDefault = mapOf traverse+--+-- > sets . mapOf = id+-- > mapOf . sets = id+--+-- > mapOf :: Setter a b c d      -> (c -> d) -> a -> b+-- > mapOf :: Iso a b c d         -> (c -> d) -> a -> b+-- > mapOf :: Lens a b c d        -> (c -> d) -> a -> b+-- > mapOf :: Traversal a b c d   -> (c -> d) -> a -> b+mapOf :: Setting a b c d -> (c -> d) -> a -> b+mapOf = adjust+{-# INLINE mapOf #-}++-- | Replace the target of a 'Lens' or all of the targets of a 'Setter'+-- or 'Traversal' with a constant value.+--+-- > (<$) = set mapped+--+-- > set :: Setter a b c d    -> d -> a -> b+-- > set :: Iso a b c d       -> d -> a -> b+-- > set :: Lens a b c d      -> d -> a -> b+-- > set :: Traversal a b c d -> d -> a -> b+set :: Setting a b c d -> d -> a -> b+set l d = runMutator . l (\_ -> Mutator d)+{-# INLINE set #-}++-- | Modifies the target of a 'Lens' or all of the targets of a 'Setter' or+-- 'Traversal' with a user supplied function.+--+-- This is an infix version of 'adjust'+--+-- > fmap f = mapped %~ f+-- > fmapDefault f = traverse %~ f+--+-- > ghci> _2 %~ length $ (1,"hello")+-- > (1,5)+--+-- > (%~) :: Setter a b c d    -> (c -> d) -> a -> b+-- > (%~) :: Iso a b c d       -> (c -> d) -> a -> b+-- > (%~) :: Lens a b c d      -> (c -> d) -> a -> b+-- > (%~) :: Traversal a b c d -> (c -> d) -> a -> b+(%~) :: Setting a b c d -> (c -> d) -> a -> b+(%~) = adjust+{-# INLINE (%~) #-}++-- | Replace the target of a 'Lens' or all of the targets of a 'Setter'+-- or 'Traversal' with a constant value.+--+-- This is an infix version of 'set', provided for consistency with '(.=)'+--+--+-- > f <$ a = mapped .~ f $ a+--+-- > ghci> bitAt 0 .~ True $ 0+-- > 1+--+-- > (.~) :: Setter a b c d    -> d -> a -> b+-- > (.~) :: Iso a b c d       -> d -> a -> b+-- > (.~) :: Lens a b c d      -> d -> a -> b+-- > (.~) :: Traversal a b c d -> d -> a -> b+(.~) :: Setting a b c d -> d -> a -> b+(.~) = set+{-# INLINE (.~) #-}++-- | Increment the target(s) of a numerically valued 'Lens', Setter' or 'Traversal'+--+-- > ghci> _1 +~ 1 $ (1,2)+-- > (2,2)+(+~) :: Num c => Setting a b c c -> c -> a -> b+l +~ n = adjust l (+ n)+{-# INLINE (+~) #-}++-- | Multiply the target(s) of a numerically valued 'Lens', 'Iso', 'Setter' or 'Traversal'+--+-- >>> _2 *~ 4 $ (1,2)+-- (1,8)+(*~) :: Num c => Setting a b c c -> c -> a -> b+l *~ n = adjust l (* n)+{-# INLINE (*~) #-}++-- | Decrement the target(s) of a numerically valued 'Lens', 'Iso', 'Setter' or 'Traversal'+--+-- >>> _1 -~ 2 $ (1,2)+-- (-1,2)+(-~) :: Num c => Setting a b c c -> c -> a -> b+l -~ n = adjust l (subtract n)+{-# INLINE (-~) #-}++-- | Divide the target(s) of a numerically valued 'Lens', 'Iso', 'Setter' or 'Traversal'+(//~) :: Fractional c => Setting a b c c -> c -> a -> b+l //~ n = adjust l (/ n)++-- | Raise the target(s) of a numerically valued 'Lens', 'Setter' or 'Traversal' to a non-negative integral power+--+-- >>> _2 ^~ 2 $ (1,3)+-- (1,9)+(^~) :: (Num c, Integral e) => Setting a b c c -> e -> a -> b+l ^~ n = adjust l (^ n)+{-# INLINE (^~) #-}++-- | Raise the target(s) of a fractionally valued 'Lens', 'Setter' or 'Traversal' to an integral power+--+-- >>> _2 ^^~ (-1) $ (1,2)+-- (1,0.5)+(^^~) :: (Fractional c, Integral e) => Setting a b c c -> e -> a -> b+l ^^~ n = adjust l (^^ n)+{-# INLINE (^^~) #-}++-- | Raise the target(s) of a floating-point valued 'Lens', 'Setter' or 'Traversal' to an arbitrary power.+--+-- >>> _2 **~ pi $ (1,3)+-- (1,31.54428070019754)+(**~) :: Floating c => Setting a b c c -> c -> a -> b+l **~ n = adjust l (** n)+{-# INLINE (**~) #-}++-- | Logically '||' the target(s) of a 'Bool'-valued 'Lens' or 'Setter'+(||~):: Setting a b Bool Bool -> Bool -> a -> b+l ||~ n = adjust l (|| n)+{-# INLINE (||~) #-}++-- | Logically '&&' the target(s) of a 'Bool'-valued 'Lens' or 'Setter'+(&&~) :: Setting a b Bool Bool -> Bool -> a -> b+l &&~ n = adjust l (&& n)+{-# INLINE (&&~) #-}++-- | Modify the target of a monoidally valued by 'mappend'ing another value.+(<>~) :: Monoid c => Setting a b c c -> c -> a -> b+l <>~ n = adjust l (mappend n)+{-# INLINE (<>~) #-}++------------------------------------------------------------------------------+-- Using Setters with State+------------------------------------------------------------------------------++-- | Replace the target of a 'Lens' or all of the targets of a 'Setter' or 'Traversal' in our monadic+-- state with a new value, irrespective of the old.+--+-- > (.=) :: MonadState a m => Iso a a c d             -> d -> m ()+-- > (.=) :: MonadState a m => Lens a a c d            -> d -> m ()+-- > (.=) :: MonadState a m => 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."+(.=) :: MonadState a m => Setting a a c d -> d -> m ()+l .= b = State.modify (l .~ b)+{-# INLINE (.=) #-}++-- | Map over the target of a 'Lens' or all of the targets of a 'Setter' or 'Traversal in our monadic state.+--+-- > (%=) :: MonadState a m => Iso a a c d             -> (c -> d) -> m ()+-- > (%=) :: MonadState a m => Lens a a c d            -> (c -> d) -> m ()+-- > (%=) :: MonadState a m => 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)+{-# INLINE (%=) #-}++-- | Modify the target(s) of a 'Simple' 'Lens', 'Iso', 'Setter' or 'Traversal' by adding a value+--+-- Example:+--+-- > fresh = do+-- >   id += 1+-- >   access id+(+=) :: (MonadState a m, Num b) => SimpleSetting a b -> b -> m ()+l += b = State.modify (l +~ b)+{-# INLINE (+=) #-}++-- | Modify the target(s) of a 'Simple' 'Lens', 'Iso', 'Setter' or 'Traversal' by subtracting a value+(-=) :: (MonadState a m, Num b) => SimpleSetting a b -> b -> m ()+l -= b = State.modify (l -~ b)+{-# INLINE (-=) #-}++-- | Modify the target(s) of a 'Simple' 'Lens', 'Iso', 'Setter' or 'Traversal' by multiplying by value+(*=) :: (MonadState a m, Num b) => SimpleSetting a b -> b -> m ()+l *= b = State.modify (l *~ b)+{-# INLINE (*=) #-}++-- | Modify the target(s) of a 'Simple' 'Lens', 'Iso', 'Setter' or 'Traversal' by dividing by a value+(//=) ::  (MonadState a m, Fractional b) => SimpleSetting a b -> b -> m ()+l //= b = State.modify (l //~ b)+{-# INLINE (//=) #-}++-- | Raise the target(s) of a numerically valued 'Lens', 'Setter' or 'Traversal' to a non-negative integral power+(^=) ::  (MonadState a m, Fractional b, Integral c) => SimpleSetting a b -> c -> m ()+l ^= c = State.modify (l ^~ c)+{-# INLINE (^=) #-}++-- | Raise the target(s) of a numerically valued 'Lens', 'Setter' or 'Traversal' to an integral power+(^^=) ::  (MonadState a m, Fractional b, Integral c) => SimpleSetting a b -> c -> m ()+l ^^= c = State.modify (l ^^~ c)+{-# INLINE (^^=) #-}++-- | Raise the target(s) of a numerically valued 'Lens', 'Setter' or 'Traversal' to an arbitrary power+(**=) ::  (MonadState a m, Floating b) => SimpleSetting a b -> b -> m ()+l **= b = State.modify (l **~ b)+{-# INLINE (**=) #-}++-- | Modify the target(s) of a 'Simple' 'Lens', 'Iso', 'Setter' or 'Traversal' by taking their logical '&&' with a value+(&&=):: MonadState a m => SimpleSetting a Bool -> Bool -> m ()+l &&= b = State.modify (l &&~ b)+{-# INLINE (&&=) #-}++-- | Modify the target(s) of a 'Simple' 'Lens', 'Iso, 'Setter' or 'Traversal' by taking their logical '||' with a value+(||=) :: MonadState a m => SimpleSetting a Bool -> Bool -> m ()+l ||= b = State.modify (l ||~ b)+{-# INLINE (||=) #-}++-- | Modify the target(s) of a 'Simple' 'Lens', 'Iso', 'Setter' or 'Traversal' by 'mappend'ing a value.+(<>=) :: (MonadState a m, Monoid b) => SimpleSetting a b -> b -> m ()+l <>= b = State.modify (l <>~ b)+{-# INLINE (<>=) #-}++-- | Run a monadic action, and set all of the targets of a 'Lens', 'Setter' or 'Traversal' to its result.+--+-- > (<~) :: MonadState a m => Iso a a c d       -> m d -> m ()+-- > (<~) :: MonadState a m => Lens a a c d      -> m d -> m ()+-- > (<~) :: MonadState a m => 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+-- in a local variable.+--+-- > do foo <- bar+-- >    ...+--+-- will store the result in a variable, while+--+-- > do foo <~ bar+-- >    ...+--+-- will store the result in a lens/setter/traversal.+(<~) :: MonadState a m => Setting a a c d -> m d -> m ()+l <~ md = md >>= (l .=)+{-# INLINE (<~) #-}++------------------------------------------------------------------------------+-- MonadWriter+------------------------------------------------------------------------------++-- | Tell a part of a value to a 'MonadWriter', filling in the rest from 'mempty'+--+-- > whisper l d = tell (set l d mempty)++-- > whisper :: (MonadWriter b m, Monoid a) => Iso a b c d       -> d -> m ()+-- > whisper :: (MonadWriter b m, Monoid a) => Lens a b c d      -> d -> m ()+-- > whisper :: (MonadWriter b m, Monoid a) => Traversal a b c d -> d -> m ()+-- > whisper :: (MonadWriter b m, Monoid a) => Setter a b c d    -> d -> m ()+--+-- > whisper :: (MonadWriter b m, Monoid a) => ((c -> Identity d) -> a -> Identity b) -> d -> m ()+whisper :: (MonadWriter b m, Monoid a) => Setting a b c d -> d -> m ()+whisper l d = tell (set l d mempty)+{-# INLINE whisper #-}++-- Local definition for doctests to avoid cycles++_1 :: Functor f => (b -> f c) -> (b, a) -> f (c, a)+_1 f (a,b) = (\c -> (c,b)) <$> f a++_2 :: Functor f => (b -> f c) -> (a, b) -> f (a, c)+_2 f (a,b) = (,) a <$> f b
src/Control/Lens/TH.hs view
@@ -26,11 +26,19 @@   , makeIso   , makeLenses, makeLensesFor   , makeLensesWith+  , lensRules+  , classyRules+  , isoRules   , defaultRules   ) where  import Control.Applicative-import Control.Lens+import Control.Lens.Fold+import Control.Lens.Getter+import Control.Lens.Iso+import Control.Lens.Setter+import Control.Lens.Type+import Control.Lens.Traversal import Control.Monad import Data.Char (toLower) import Data.Foldable@@ -48,12 +56,10 @@ -- | Flags for lens construction data LensFlag   = SimpleLenses-   | SingletonAndField   | SingletonIso   | HandleSingletons   | SingletonRequired-   | CreateClass   | CreateInstance   | ClassRequired@@ -163,12 +169,10 @@ appArgs t (x:xs) = appArgs (AppT t (VarT (x^.name))) xs  apps :: Type -> [Type] -> Type-apps t [] = t-apps t (x:xs) = apps (t `AppT` x) xs+apps = Prelude.foldl AppT  appsT :: TypeQ -> [TypeQ] -> TypeQ-appsT t [] = t-appsT t (x:xs) = appsT (t `appT` x) xs+appsT = Prelude.foldl appT  -- | Given --@@ -202,8 +206,8 @@       quantified = ForallT (tyArgs ++ substTypeVars m tyArgs) (ctx ++ substTypeVars m ctx)       maybeIsoName = mkName <$> view lensIso cfg (nameBase dataConName)       lensOnly = not $ cfg^.singletonIso-      isoCon   | lensOnly  = ConT (mkName "Control.Lens.Body")-               | otherwise = ConT (mkName "Control.Lens.Iso")+      isoCon   | lensOnly  = ConT ''Lens+               | otherwise = ConT ''Iso       makeBody | lensOnly  = makeLensBody                | otherwise = makeIsoBody   isoDecls <- flip (maybe (return [])) maybeIsoName $ \isoName -> do@@ -247,8 +251,8 @@ commonFieldDescs = toList . Prelude.foldr walk mempty 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-    Nothing                   -> at nm <~ Just d                                        $ m+    Just (FieldDesc _ _ bds') -> at nm .~ Just (FieldDesc nm ty (bds `Set.union` bds')) $ m+    Nothing                   -> at nm .~ Just d                                        $ m  errorClause :: Name -> Name -> Name -> ClauseQ errorClause lensName fieldName conName@@ -272,7 +276,7 @@         x     <- newName "y"         clause [varP f, conP conName $ map varP names] (normalB                (appsE [ varE (mkName "fmap")-                      , lamE [varP x] $ appsE $ conE conName : map varE (element i <~ x $ names)+                      , lamE [varP x] $ appsE $ conE conName : map varE (element i .~ x $ names)                       , varE (mkName "f") `appE` varE (names^.element i)                       ])) []       Nothing -> errorClause lensName fieldName conName@@ -307,7 +311,7 @@       Prelude.sequence $         filter (\_ -> cfg^.createClass)           [ classD (return []) clsName [PlainTV t] []-            [ sigD methodName $ conT (mkName "Control.Lens.Lens") `appsT` [varT t,varT t, conT tyConName, conT tyConName]]]+            [ sigD methodName $ appsT (return (ConT ''Lens)) [varT t, varT t, conT tyConName, conT tyConName] ]]         ++ filter (\_ -> cfg^.createInstance)           [ instanceD (return []) (conT clsName `appT` conT tyConName)             [ funD methodName [clause [varP a] (normalB (varE a)) []]@@ -329,9 +333,12 @@                 _      -> ps              tvs' | isJust maybeClassName = PlainTV x : tvs                   | otherwise             = tvs-         let decl = SigD lensName $ ForallT tvs' qs $ ConT (mkName "Control.Lens.Lens") `apps`-                      if cfg^.simpleLenses then [aty,aty,cty,cty]-                                           else [aty,bty,cty,dty]++         let decl = SigD lensName $ ForallT tvs' qs $+                    apps (ConT ''Lens) $+                    if cfg^.simpleLenses+                    then [aty,aty,cty,cty]+                    else [aty,bty,cty,dty]          body <- makeFieldLensBody lensName nm cons $ fmap (mkName . view _2) maybeLensClass          inlining <- pragInlD lensName $ inlineSpecNoPhase True False          return [decl, body, inlining]@@ -356,31 +363,40 @@   _ -> fail "Expected the name of a data type or newtype"  -- | Build lenses with a sensible default configuration+--+-- > makeLenses = makeLensesWith lensRules makeLenses :: Name -> Q [Dec]-makeLenses = makeLensesWith-  $ lensIso   <~ const Nothing-  $ lensClass <~ const Nothing-  $ handleSingletons <~ True    -- generate an Iso for the field if its the only one-  $ defaultRules+makeLenses = makeLensesWith lensRules  -- | Make a top level isomorphism injecting _into_ the type -- -- The supplied name is required to be for a type with a single constructor that has a single argument+--+-- > makeIso = makeLensesWith isoRules makeIso :: Name -> Q [Dec]-makeIso = makeLensesWith-  $ singletonRequired <~ True-  $ singletonAndField <~ True+makeIso = makeLensesWith isoRules++-- | Rules for making an isomorphism from a data type+isoRules :: LensRules+isoRules+  = singletonRequired .~ True+  $ singletonAndField .~ True   $ defaultRules  -- | Make 'classy lenses' for a type+--+-- > makeClassy = makeLensesWith classyRules makeClassy :: Name -> Q [Dec]-makeClassy = makeLensesWith-  $ lensIso <~ const Nothing-  $ handleSingletons <~ False-  $ lensClass <~ classy-  $ classRequired <~ True-  $ defaultRules+makeClassy = makeLensesWith classyRules +-- | Rules for making lenses that precompose another lens.+classyRules :: LensRules+classyRules = lensIso .~ const Nothing+            $ handleSingletons .~ False+            $ lensClass .~ classy+            $ classRequired .~ True+            $ defaultRules+ classy :: String -> Maybe (String, String) classy n@(a:as) = Just ("Has" ++ n, toLower a:as) classy _ = Nothing@@ -392,10 +408,15 @@ -- > makeLensesFor [("_foo", "fooLens"), ("bar", "lbar")] ''Foo makeLensesFor :: [(String, String)] -> Name -> Q [Dec] makeLensesFor fields = makeLensesWith-  $ lensField <~ (`Prelude.lookup` fields)-  $ lensIso   <~ const Nothing-  $ lensClass <~ const Nothing-  $ handleSingletons <~ True+  $ lensField .~ (`Prelude.lookup` fields)+  $ lensRules++-- | Rules for making fairly simple lenses, ignoring the special cases for isomorphisms, and not making any classes.+lensRules :: LensRules+lensRules+  = lensIso   .~ const Nothing+  $ lensClass .~ const Nothing+  $ handleSingletons .~ True   $ defaultRules  -- | Derive lenses, specifying explicit pairings of @(fieldName, lensName)@@@ -406,11 +427,9 @@ -- > makeClassyFor "HasFoo" "foo" [("_foo", "fooLens"), ("bar", "lbar")] ''Foo makeClassyFor :: String -> String -> [(String, String)] -> Name -> Q [Dec] makeClassyFor clsName funName fields = makeLensesWith-  $ lensField <~ (`Prelude.lookup` fields)-  $ lensIso <~ const Nothing-  $ lensClass <~ const (Just (clsName,funName))-  $ handleSingletons <~ False-  $ defaultRules+  $ lensClass .~ const (Just (clsName,funName))+  $ 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))
+ src/Control/Lens/Traversal.hs view
@@ -0,0 +1,286 @@+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE LiberalTypeSynonyms #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Lens.Traversal+-- Copyright   :  (C) 2012 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  Rank2Types+--+-- A @'Traversal' a b c d@ is a generalization of 'traverse' from+-- 'Traversable'. It allows you to traverse over a structure and change out+-- its contents with monadic or applicative side-effects. Starting from+--+-- @'traverse' :: ('Traversable' t, 'Applicative' f) => (c -> f d) -> t c -> f (t d)@,+--+-- we monomorphize the contents and result to obtain+--+--  > type Traversal a b c d = forall f. Applicative f => (c -> f d) -> a -> f b+--+-- While a 'Traversal' isn't quite a 'Fold', it _can_ be used for 'Getting'+-- like a 'Fold', because given a 'Monoid' @m@, we have an 'Applicative'+-- for @('Const' m)@. Everything you know how to do with a 'Traversable'+-- container, you can with with a 'Traversal', and here we provide+-- combinators that generalize the usual 'Traversable' operations.+----------------------------------------------------------------------------+module Control.Lens.Traversal+  (+  -- * Lenses+    Traversal++  -- ** Lensing Traversals+  , element+  , elementOf++  -- * Traversing and Lensing+  , traverseOf, forOf, sequenceAOf+  , mapMOf, forMOf, sequenceOf+  , transposeOf+  , mapAccumLOf, mapAccumROf+  , scanr1Of, scanl1Of++  -- * Common Traversals+  , Traversable(traverse)+  , traverseNothing++  -- * Simple+  , SimpleTraversal+  ) where++import Control.Applicative              as Applicative+import Control.Applicative.Backwards+import Control.Lens.Fold+import Control.Lens.Internal+import Control.Lens.Type+import Control.Monad.State.Class        as State+import Control.Monad.Trans.State.Lazy   as Lazy+import Data.Traversable++------------------------------------------------------------------------------+-- Traversals+------------------------------------------------------------------------------++-- | A 'Traversal' can be used directly as a 'Setter' or a 'Fold' (but not as a 'Lens') and provides+-- the ability to both read and update multiple fields, subject to some relatively weak 'Traversal' laws.+--+-- These have also been known as multilenses, but they have the signature and spirit of+--+-- > traverse :: Traversable f => Traversal (f a) (f b) a b+--+-- and the more evocative name suggests their application.+--+-- Most of the time the 'Traversal' you will want to use is just 'traverse', but you can also pass any+-- 'Lens' or 'Iso' as a Traversal, and composition of a 'Traversal' (or 'Lens' or 'Iso') with a 'Traversal' (or 'Lens' or 'Iso')+-- using (.) forms a valid 'Traversal'.+--+-- The laws for a Traversal @t@ follow from the laws for Traversable as stated in \"The Essence of the Iterator Pattern\".+--+-- 1) Idiomatic naturality:+--+-- > t pure = pure+--+-- 2) Sequential composition:+--+-- > fmap (t f) . t g = getCompose . t (Compose . fmap f . g)+--+-- One consequence of this requirement is that a traversal needs to leave the same number of elements as a candidate for +-- subsequent traversal as it started with.+--+-- 3) No duplication of elements (as defined in \"The Essence of the Iterator Pattern\" section 5.5), which states+-- that you should incur no effect caused by visiting the same element of the container twice.+type Traversal a b c d = forall f. Applicative f => (c -> f d) -> a -> f b++-- | > type SimpleTraversal = Simple Traversal+type SimpleTraversal a b = Traversal a a b b++--------------------------+-- Traversal Combinators+--------------------------++-- |+-- Map each element of a structure targeted by a Lens or Traversal,+-- evaluate these actions from left to right, and collect the results.+--+-- > traverseOf = id+--+-- > traverse = traverseOf traverse+--+-- > traverseOf :: Iso a b c d       -> (c -> f d) -> a -> f b+-- > traverseOf :: Lens a b c d      -> (c -> f d) -> a -> f b+-- > traverseOf :: Traversal a b c d -> (c -> f d) -> a -> f b+traverseOf :: LensLike f a b c d -> (c -> f d) -> a -> f b+traverseOf = id+{-# INLINE traverseOf #-}++-- |+--+-- > forOf l = flip (traverseOf l)+--+-- > for = forOf traverse+-- > forOf = morphism flip flip+--+-- > forOf :: Lens 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+{-# INLINE forOf #-}++-- |+-- Evaluate each action in the structure from left to right, and collect+-- the results.+--+-- > sequenceA = sequenceAOf traverse+-- > sequenceAOf l = traverseOf l id+-- > sequenceAOf l = l id+--+-- > sequenceAOf ::                  Iso a b (f c) c       -> a -> f b+-- > sequenceAOf ::                  Lens a b (f c) c      -> a -> f b+-- > sequenceAOf :: Applicative f => Traversal a b (f c) c -> a -> f b+sequenceAOf :: LensLike f a b (f c) c -> a -> f b+sequenceAOf l = l id+{-# INLINE sequenceAOf #-}++-- | Map each element of a structure targeted by a lens to a monadic action,+-- evaluate these actions from left to right, and collect the results.+--+-- > mapM = mapMOf traverse+--+-- > mapMOf ::            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)+{-# INLINE mapMOf #-}++-- |+-- > forM = forMOf traverse+-- > forMOf l = flip (mapMOf l)+--+-- > forMOf ::            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)+{-# INLINE forMOf #-}++-- |+-- > sequence = sequenceOf traverse+-- > sequenceOf l = mapMOf l id+-- > sequenceOf l = unwrapMonad . l WrapMonad+--+-- > sequenceOf ::            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+{-# INLINE sequenceOf #-}++-- | This generalizes 'Data.List.transpose' to an arbitrary 'Traversal'.+--+-- > transpose = transposeOf traverse+--+-- > ghci> transposeOf traverse [[1,2,3],[4,5,6]]+-- > [[1,4],[2,5],[3,6]]+--+-- Since every 'Lens' is a Traversal, we can use this as a form of+-- monadic strength.+--+-- > transposeOf _2 :: (b, [a]) -> [(b, a)]+transposeOf :: LensLike ZipList a b [c] c -> a -> [b]+transposeOf l = getZipList . l ZipList+{-# INLINE transposeOf #-}++-- | Generalizes 'Data.Traversable.mapAccumR' to an arbitrary 'Traversal'.+--+-- > mapAccumR = mapAccumROf traverse+--+-- 'mapAccumROf' accumulates state from right to left.+--+-- > mapAccumROf :: 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)+{-# INLINE mapAccumROf #-}++-- | Generalized 'Data.Traversable.mapAccumL' to an arbitrary 'Traversal'.+--+-- > mapAccumL = mapAccumLOf traverse+--+-- 'mapAccumLOf' accumulates state from left to right.+--+-- > mapAccumLOf :: 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+{-# INLINE mapAccumLOf #-}++swap :: (a,b) -> (b,a)+swap (a,b) = (b,a)+{-# INLINE swap #-}++-- | Permit the use of 'scanr1' over an arbitrary 'Traversal' or 'Lens'.+--+-- > scanr1 = scanr1Of 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 :: LensLike (Lazy.State (Maybe c)) a b c c -> (c -> c -> c) -> a -> b+scanr1Of l f = snd . mapAccumROf l step Nothing where+  step Nothing c  = (Just c, c)+  step (Just s) c = (Just r, r) where r = f c s+{-# INLINE scanr1Of #-}++-- | Permit the use of 'scanl1' over an arbitrary 'Traversal' or 'Lens'.+--+-- > 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+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+  step Nothing c  = (Just c, c)+  step (Just s) c = (Just r, r) where r = f s c+{-# INLINE scanl1Of #-}++------------------------------------------------------------------------------+-- Common Lenses+------------------------------------------------------------------------------++-- | A 'Lens' to view/edit the nth element 'elementOf' a 'Traversal', 'Lens' or 'Iso'.+--+-- Attempts to access beyond the range of the 'Traversal' will cause an error.+--+-- > ghci> [[1],[3,4]]^.elementOf (traverse.traverse) 1+-- > 3+elementOf :: Functor f => LensLike (ElementOf f) a b c c -> Int -> LensLike f a b c c+elementOf l i f a = case getElementOf (l go a) 0 of+    Found _ fb    -> fb+    Searching _ _ -> error "elementOf: index out of range"+    NotFound e    -> error $ "elementOf: " ++ e+  where+    go c = ElementOf $ \j -> if i == j then Found (j + 1) (f c) else Searching (j + 1) c++-- | Access the nth element of a 'Traversable' container.+--+-- Attempts to access beyond the range of the 'Traversal' will cause an error.+--+-- > element = elementOf traverse+element :: Traversable t => Int -> Simple Lens (t a) a+element = elementOf traverse++------------------------------------------------------------------------------+-- Traversals+------------------------------------------------------------------------------++-- | 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 #-}+
+ src/Control/Lens/Type.hs view
@@ -0,0 +1,348 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE LiberalTypeSynonyms #-}+{-# LANGUAGE FlexibleContexts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Lens.Type+-- Copyright   :  (C) 2012 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  Rank2Types+--+-- A @'Lens' a b c d@ is a purely functional reference.+--+-- While a 'Traversal' could be used for 'Getting' like a valid 'Fold',+-- it wasn't a valid 'Getter' as Applicative isn't a superclass of +-- 'Gettable'.+--+-- 'Functor', however is the superclass of both.+--+-- > type Lens a b c d = forall f. Functor f => (c -> f d) -> a -> f b+--+-- Every 'Lens' is a valid 'Setter', choosing @f@ = 'Identity'.+--+-- Every 'Lens' can be used for 'Getting' like a 'Fold' that doesn't use+-- the 'Monoid'.+--+-- Every 'Lens' is a valid 'Traversal' that only uses the 'Functor' part+-- of the 'Applicative' it is supplied.+--+-- Every 'Lens' can be used for 'Getting' like a valid 'Getter', choosing+-- @f@ = 'Accessor' @r@ for an appropriate @r@+--+-- Since every 'Lens' can be used for 'Getting' like a valid 'Getter' it+-- follows that it must view exactly one element in the structure.+--+-- The lens laws follow from this property and the desire for it to act like+-- a 'Traversable' when used as a 'Traversal'.+----------------------------------------------------------------------------+module Control.Lens.Type+  (+  -- * Lenses+    Lens+  , Simple+  , lens+  , (%%~)+  , (%%=)++  -- ** Common Lenses+  , _1, _2+  , resultAt++  -- * Traversing and Lensing+  , Focus(..)++  -- * Cloning Lenses+  , clone+  , merged+  , bothLenses++  -- * Simplified and In-Progress+  , LensLike+  , Overloaded+  , SimpleLens+  , SimpleLensLike+  , SimpleOverloaded+  ) where++import Control.Applicative              as Applicative+import Control.Lens.Internal+import Control.Lens.Setter+import Control.Monad+import Control.Monad.State.Class        as State+import Control.Monad.Trans.State.Lazy   as Lazy+import Control.Monad.Trans.State.Strict as Strict+import Control.Monad.Trans.Reader+import Data.Functor.Identity++infixr 4 %%~+infix  4 %%=++--------------------------+-- Lenses+--------------------------++-- | A 'Lens' is actually a lens family as described in <http://comonad.com/reader/2012/mirrored-lenses/>.+--+-- With great power comes great responsibility and a 'Lens' is subject to the three common sense lens laws:+--+-- 1) You get back what you put in:+--+-- > view l (set l b a)  = b+--+-- 2) Putting back what you got doesn't change anything:+--+-- > set l (view l a) a  = a+--+-- 3) Setting twice is the same as setting once:+--+-- > set l c (set l b a) = set l c a+--+-- These laws are strong enough that the 4 type parameters of a 'Lens' cannot vary fully independently. For more on+-- how they interact, read the "Why is it a Lens Family?" section of <http://comonad.com/reader/2012/mirrored-lenses/>.+--+-- Every 'Lens' can be used directly as a 'Setter' or 'Traversal'.+--+-- You can also use a 'Lens' for 'Getting' as if it were a 'Fold' or 'Getter'.+--+-- Since every lens is a valid 'Traversal', the traversal laws should also apply to any lenses you create.+--+-- 1.) Idiomatic naturality:+--+-- > l pure = pure+--+-- 2.) Sequential composition:+--+-- > fmap (l f) . l g = getCompose . l (Compose . fmap f . g)+--+-- > type Lens = forall f. Functor f => LensLike f a b c d+type Lens a b c d = forall f. Functor f => (c -> f d) -> a -> f b++-- | A @'Simple' 'Lens'@, @'Simple' 'Traversal'@, ... can be used instead of a 'Lens','Traversal', ...+-- whenever the type variables don't change upon setting a value.+--+-- > imaginary :: Simple Lens (Complex a) a+-- > traverseHead :: Simple Traversal [a] a+--+-- Note: To use this alias in your own code with @'LensLike' f@ or @Setter@, you may have to turn on+-- @LiberalTypeSynonyms@.+type Simple f a b = f a a b b++-- | > type SimpleLens = Simple Lens+type SimpleLens a b = Lens a a b b++-- | > type SimpleLensLike f = Simple (LensLike f)+type SimpleLensLike f a b = LensLike f a a b b++--------------------------+-- Constructing Lenses+--------------------------++-- | Build a 'Lens' from a getter and a setter.+--+-- > lens :: Functor f => (a -> c) -> (a -> d -> b) -> (c -> f d) -> a -> f b+lens :: (a -> c) -> (a -> d -> b) -> Lens a b c d+lens ac adb cfd a = adb a <$> cfd (ac a)+{-# INLINE lens #-}++--------------------------+-- LensLike+--------------------------++-- |+-- Many combinators that accept a 'Lens' can also accept a 'Traversal' in limited situations.+--+-- They do so by specializing the type of 'Functor' that they require of the caller.+--+-- If a function accepts a @'LensLike' f a b c d@ for some 'Functor' @f@, then they may be passed a 'Lens'.+--+-- Further, if @f@ is an 'Applicative', they may also be passed a 'Traversal'.+type LensLike f a b c d = (c -> f d) -> a -> f b++-- | ('%%~') can be used in one of two scenarios:+--+-- When applied to a 'Lens', it can edit the target of the 'Lens' in a structure, extracting a+-- functorial result.+--+-- When applied to a 'Traversal', it can edit the targets of the 'Traversals', extracting an+-- applicative summary of its actions.+--+-- For all that the definition of this combinator is just:+--+-- > (%%~) = id+--+-- > (%%~) :: Functor f =>     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 => 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 restrictive types, however:+--+-- When applied to a 'Traversal', it can edit the targets of the 'Traversals', extracting a+-- supplemental monoidal summary of its actions, by choosing f = ((,) m)+--+-- > (%%~) ::             Iso a b c d       -> (c -> (e, d)) -> a -> (e, b)+-- > (%%~) ::             Lens a b c d      -> (c -> (e, d)) -> a -> (e, b)+-- > (%%~) :: Monoid m => Traversal a b c d -> (c -> (m, d)) -> a -> (m, b)+(%%~) :: LensLike f a b c d -> (c -> f d) -> a -> f b+(%%~) = id+{-# INLINE (%%~) #-}++-- | Modify the target of a 'Lens' in the current state returning some extra information of @c@ or+-- modify all targets of a 'Traversal' in the current state, extracting extra information of type @c@+-- and return a monoidal summary of the changes.+--+-- > (%%=) = (state.)+--+-- It may be useful to think of ('%%='), instead, as having either of the following more restricted+-- type signatures:+--+-- > (%%=) :: MonadState a m             => 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) => 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)+l %%= f = State.state (l f)+#else+l %%= f = do+  (e, b) <- State.gets (l f)+  State.put b+  return e+#endif+{-# INLINE (%%=) #-}++-- | This class allows us to use 'focus' on a number of different monad transformers.+class Focus st where+  -- | Run a monadic action in a larger context than it was defined in, using a 'Simple' 'Lens' or 'Simple' 'Traversal'.+  --+  -- This is commonly used to lift actions in a simpler state monad into a state monad with a larger state type.+  --+  -- When applied to a 'Simple 'Traversal' over multiple values, the actions for each target are executed sequentially+  -- and the results are aggregated monoidally+  -- and a monoidal summary+  -- of the result is given.+  --+  -- > focus :: Monad m             => Simple Iso a b       -> st b m c -> st a m c+  -- > focus :: Monad m             => Simple Lens a b      -> st b m c -> st a m c+  -- > focus :: (Monad m, Monoid c) => Simple Traversal a b -> st b m c -> st a m c+  focus :: Monad m => LensLike (Focusing m c) a a b b -> st b m c -> st a m c++  -- | Like 'focus', but discarding any accumulated results as you go.+  --+  -- > focus_ :: Monad m             => Simple Iso a b       -> st b m c -> st a m ()+  -- > focus_ :: Monad m             => Simple Lens a b      -> st b m c -> st a m ()+  -- > focus_ :: (Monad m, Monoid c) => Simple Traversal a b -> st b m c -> st a m ()+  focus_ :: Monad m => LensLike (Focusing m ()) a a b b -> st b m c -> st a m ()++  -- | A much more limited version of 'focus' that can work with a 'Setter'.+  setFocus :: Simple Setter a b -> st b Identity c -> st a Identity ()++skip :: a -> ()+skip _ = ()+{-# INLINE skip #-}++instance Focus Strict.StateT where+  focus l m = Strict.StateT $ unfocusing . l (Focusing . Strict.runStateT m)+  {-# INLINE focus #-}+  focus_ l m = Strict.StateT $ unfocusing . l (Focusing . Strict.runStateT (liftM skip m))+  {-# INLINE focus_ #-}+  setFocus l m = Strict.state $ (,) () . runIdentity . l (Identity . snd . Strict.runState m)++instance Focus Lazy.StateT where+  focus l m = Lazy.StateT $ unfocusing . l (Focusing . Lazy.runStateT m)+  {-# INLINE focus #-}+  focus_ l m = Lazy.StateT $ unfocusing . l (Focusing . Lazy.runStateT (liftM skip m))+  {-# INLINE focus_ #-}+  setFocus l m = Lazy.state $ (,) () . runIdentity . l (Identity . snd . Lazy.runState m)++instance Focus ReaderT where+  --focus l m = ReaderT $ \a -> liftM fst $ unfocusing $ l (\b -> Focusing $ (\c -> (c,b)) `liftM` runReaderT m b) a+  focus l m = ReaderT $ liftM fst . unfocusing . l (\b -> Focusing $ (\c -> (c,b)) `liftM` runReaderT m b)+  {-# INLINE focus #-}+  focus_ l m = ReaderT $ \a -> liftM skip $ unfocusing $ l (\b -> Focusing $ (\_ -> ((),b)) `liftM` runReaderT m b) a+  {-# INLINE focus_ #-}+  setFocus _ _ = return () -- BOOORING++------------------------------------------------------------------------------+-- Common Lenses+------------------------------------------------------------------------------++-- | This is a lens that can change the value (and type) of the first field of+-- a pair.+--+-- > ghci> (1,2)^._1+-- > 1+--+-- > ghci> _1 +~ "hello" $ (1,2)+-- > ("hello",2)+--+-- > _1 :: Functor f => (a -> f b) -> (a,c) -> f (a,c)+_1 :: Lens (a,c) (b,c) a b+_1 f (a,c) = (\b -> (b,c)) <$> f a+{-# INLINE _1 #-}++-- | As '_1', but for the second field of a pair.+--+-- > anyOf _2 :: (c -> Bool) -> (a, c) -> Bool+-- > traverse._2 :: (Applicative f, Traversable t) => (a -> f b) -> t (c, a) -> f (t (c, b))+-- > foldMapOf (traverse._2) :: (Traversable t, Monoid m) => (c -> m) -> t (b, c) -> m+--+-- > _2 :: Functor f => (a -> f b) -> (c,a) -> f (c,b)+_2 :: Lens (c,a) (c,b) a b+_2 f (c,a) = (,) c <$> f a+{-# INLINE _2 #-}++-- | This lens can be used to change the result of a function but only where+-- the arguments match the key given.+resultAt :: Eq e => e -> Simple Lens (e -> a) a+resultAt e afa ea = go <$> afa a where+  a = ea e+  go a' e' | e == e'   = a'+           | otherwise = a+{-# INLINE resultAt #-}++-- | Merge two lenses, getters, setters, folds or traversals.+merged :: Functor f => LensLike f a b c c -> LensLike f a' b' c c -> LensLike f (Either a a') (Either b b') c c+merged l _ f (Left a)   = Left <$> l f a+merged _ r f (Right a') = Right <$> r f a'+{-# INLINE merged #-}++-- | 'bothLenses' makes a lens from two other lenses (or isomorphisms)+bothLenses :: Lens a b c d -> Lens a' b' c' d' -> Lens (a,a') (b,b') (c,c') (d,d')+bothLenses 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')+{-# INLINE bothLenses #-}++------------------------------------------------------------------------------+-- Cloning Lenses+------------------------------------------------------------------------------++-- |+--+-- Cloning a 'Lens' is one way to make sure you arent given+-- something weaker, such as a 'Traversal' and can be used+-- as a way to pass around lenses that have to be monomorphic in 'f'.+--+-- Note: This only accepts a proper 'Lens', because 'IndexedStore' lacks its+-- (admissable) Applicative instance.+--+clone :: Functor f+      => LensLike (IndexedStore c d) a b c d+      -> (c -> f d) -> a -> f b+clone f cfd a = case f (IndexedStore id) a of+  IndexedStore db c -> db <$> cfd c+{-# INLINE clone #-}++-----------------------------------------------------------------------------+-- Overloading function application+-----------------------------------------------------------------------------++-- | > type LensLike f a b c d = Overloaded (->) f a b c d+type Overloaded k f a b c d = k (c -> f d) (a -> f b)++-- | > type SimpleOverloaded k f a b = Simple (Overloaded k f) a b+type SimpleOverloaded k f a b = Overloaded k f a a b b+
src/Control/Seq/Lens.hs view
@@ -16,7 +16,7 @@ import Control.Lens import Control.Seq --- | Evaluate the elements targeted by a 'Lens', 'Traversal', 'Iso', +-- | Evaluate the elements targeted by a 'Lens', 'Traversal', 'Iso', -- 'Getter' or 'Fold' according to the given strategy. -- -- > seqFoldable = seqOf folded
src/Data/Array/Lens.hs view
@@ -16,7 +16,6 @@   -- * Indexing     ix   -- * Setters-  , amapped   , ixmapped   -- * Traversal   , traverseArray@@ -24,7 +23,7 @@  import Control.Applicative import Control.Lens-import Data.Array.IArray+import Data.Array.IArray hiding (index)  -- | Access an element of an array. --@@ -33,26 +32,16 @@ -- > arr ! i = arr^.ix i -- > arr // [(i,e)] = ix i ^= e $ arr ----- > ghci> ix 2 ^= 9 $ listArray (1,5) [4,5,6,7,8]--- > array (1,5) [4,9,6,7,8]+-- >>> ix 2 ^= 9 $ listArray (1,5) [4,5,6,7,8]+-- array (1,5) [4,9,6,7,8] ix :: (IArray a e, Ix i) => i -> Simple Lens (a i e) e ix i f arr = (\e -> arr // [(i,e)]) <$> f (arr ! i) {-# INLINE ix #-} --- | This setter can be used to map over all of the values in an array.------ Note: 'traverseArray' is strictly more general and permits more operations------ > amap = adjust amapped--- > amapped = sets amap-amapped :: (IArray a c, IArray a d, Ix i) => Setter (a i c) (a i d) c d-amapped = sets amap-{-# INLINE amapped #-}- -- | This setter can be used to derive a new array from an old array by -- applying a function to each of the indices. ----- This is a /contravariant/ Setter.+-- This is a /contravariant/ 'Setter'. -- -- > ixmap = adjust . ixmapped -- > ixmapped = sets . ixmap@@ -63,9 +52,10 @@ ixmapped = sets . ixmap {-# INLINE ixmapped #-} --- | Generic 'Traversal' of the elements of an array.+-- | Generic 'IndexedTraversal' of the elements of an array, using the index into the+-- array as the index of the traversal. -- -- > amap = adjust traverseArray-traverseArray :: (IArray a c, IArray a d, Ix i) => Traversal (a i c) (a i d) c d-traverseArray f arr = array (bounds arr) <$> (traverse._2) f (assocs arr)+traverseArray :: (IArray a c, IArray a d, Ix i) => IndexedTraversal i (a i c) (a i d) c d+traverseArray = index $ \f arr -> array (bounds arr) <$> traverse (\(i,a) -> (,) i <$> f i a) (assocs arr) {-# INLINE traverseArray #-}
src/Data/Bits/Lens.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE LiberalTypeSynonyms #-}+{-# LANGUAGE FlexibleContexts #-} ----------------------------------------------------------------------------- -- | -- Module      :  Data.Bits.Lens@@ -25,48 +26,59 @@ infix 4 |=, &=  -- | Bitwise '.|.' the target(s) of a 'Bool'-valued 'Lens' or 'Setter'-(|~):: Bits c => Setter a b c c -> c -> a -> b+--+-- >>> _2 |~ 6 $ ("hello",3)+-- ("hello",7)+(|~):: Bits c => Setting a b c c -> c -> a -> b l |~ n = adjust l (.|. n) {-# INLINE (|~) #-}  -- | Bitwise '.&.' the target(s) of a 'Bool'-valued 'Lens' or 'Setter'-(&~) :: Bits c => Setter a b c c -> c -> a -> b+--+-- >>> _2 &~ 7 $ ("hello",254)+-- ("hello",6)+(&~) :: Bits c => Setting a b c c -> c -> a -> b l &~ n = adjust l (.&. n) {-# INLINE (&~) #-}  -- | Modify the target(s) of a 'Simple' 'Lens', 'Setter' or 'Traversal' by computing its bitwise '.&.' with another value.-(&=):: (MonadState a m, Bits b) => Simple Setter a b -> b -> m ()+(&=):: (MonadState a m, Bits b) => Simple Setting a b -> b -> m () l &= b = modify (l &~ b) {-# INLINE (&=) #-}  -- | Modify the target(s) of a 'Simple' 'Lens', 'Setter' or 'Traversal' by computing its bitwise '.|.' with another value.-(|=) :: (MonadState a m, Bits b) => Simple Setter a b -> b -> m ()+(|=) :: (MonadState a m, Bits b) => Simple Setting a b -> b -> m () l |= b = modify (l |~ b) {-# INLINE (|=) #-}  -- | This lens can be used to access the value of the nth bit in a number. ----- @bitsAt n@ is only a legal 'Lens' into @b@ if @0 <= n < bitSize (undefined :: b)@+-- @bitAt n@ is only a legal 'Lens' into @b@ if @0 <= n < bitSize (undefined :: b)@+--+-- >>> 16^.bitAt 4+-- True+--+-- >>> 15^.bitAt 4+-- False bitAt :: Bits b => Int -> Simple Lens b Bool bitAt n f b = (\x -> if x then setBit b n else clearBit b n) <$> f (testBit b n) {-# INLINE bitAt #-}  -- | Traverse over all bits in a numeric type. ----- > ghci> toListOf traverseBits (5 :: Word8)--- > [True,False,True,False,False,False,False,False]+-- The bit position is available as the index. --+-- >>> toListOf traverseBits (5 :: Word8)+-- [True,False,True,False,False,False,False,False]+-- -- If you supply this an Integer, it won't crash, but the result will -- be an infinite traversal that can be productively consumed.------ > ghci> toListOf traverseBits 5--- > [True,False,True,False,False,False,False,False,False,False,False,False...-traverseBits :: Bits b => Simple Traversal b Bool-traverseBits f b = Prelude.foldr step 0 <$> traverse g bits-  where-    g n      = (,) n <$> f (testBit b n)+traverseBits :: Bits b => SimpleIndexedTraversal Int b Bool+traverseBits = index $ \f b -> let+    g n      = (,) n <$> f n (testBit b n)     bits     = Prelude.takeWhile hasBit [0..]     hasBit n = complementBit b n /= b -- test to make sure that complementing this bit actually changes the value     step (n,True) r = setBit r n     step _        r = r+  in Prelude.foldr step 0 <$> traverse g bits {-# INLINE traverseBits #-}
src/Data/IntMap/Lens.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LiberalTypeSynonyms #-} ----------------------------------------------------------------------------- -- |@@ -13,6 +14,7 @@ ---------------------------------------------------------------------------- module Data.IntMap.Lens   ( at+  , traverseIntMap   , traverseAt   , traverseAtMin   , traverseAtMax@@ -21,14 +23,15 @@ 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'. ----- > ghci> fromList [(1,"hello")] ^.at 1--- > Just "hello"+-- >>> fromList [(1,"hello")] ^.at 1+-- Just "hello" ----- > ghci> at 1 ^~ Just "hello" $ mempty--- > fromList [(1,"hello")]+-- >>> at 1 .~ Just "hello" $ IntMap.empty+-- fromList [(1,"hello")] -- -- > at :: Int -> (Maybe v -> f (Maybe v)) -> IntMap v -> f (IntMap v) at :: Int -> Simple Lens (IntMap v) (Maybe v)@@ -37,6 +40,11 @@   go (Just v') = IntMap.insert k v' m {-# 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)@@ -46,23 +54,25 @@ {-# INLINE traverseAt #-}  -- | Traverse the value at the minimum key in a Map-traverseAtMin :: Simple Traversal (IntMap v) v-traverseAtMin f m = case IntMap.minView m of+--+-- The key of the minimum element is available as the index.+traverseAtMin :: SimpleIndexedTraversal Int (IntMap v) v+traverseAtMin = index $ \f m -> case IntMap.minViewWithKey m of #if MIN_VERSION_containers(0,5,0)-  Just (a, _) -> (\v -> IntMap.updateMin (const (Just v)) m) <$> f a+  Just ((k,a), _) -> (\v -> IntMap.updateMin (const (Just v)) m) <$> f k a #else-  Just (a, _) -> (\v -> IntMap.updateMin (const v) m) <$> f a+  Just ((k,a), _) -> (\v -> IntMap.updateMin (const v) m) <$> f k a #endif   Nothing     -> pure m {-# INLINE traverseAtMin #-}  -- | Traverse the value at the maximum key in a Map-traverseAtMax :: Simple Traversal (IntMap v) v-traverseAtMax f m = case IntMap.maxView m of+traverseAtMax :: SimpleIndexedTraversal Int (IntMap v) v+traverseAtMax = index $ \f m -> case IntMap.maxViewWithKey m of #if MIN_VERSION_containers(0,5,0)-    Just (a, _) -> (\v -> IntMap.updateMax (const (Just v)) m) <$> f a+    Just ((k,a), _) -> (\v -> IntMap.updateMax (const (Just v)) m) <$> f k a #else-    Just (a, _) -> (\v -> IntMap.updateMax (const v) m) <$> f a+    Just ((k,a), _) -> (\v -> IntMap.updateMax (const v) m) <$> f k a #endif     Nothing     -> pure m {-# INLINE traverseAtMax #-}
src/Data/IntSet/Lens.hs view
@@ -11,6 +11,7 @@ module Data.IntSet.Lens   ( contains   , members+  , setmapped   , setOf   ) where @@ -30,6 +31,13 @@   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+ -- | This 'Setter' can be used to change the contents of an 'IntSet' by mapping -- the elements to new values. --@@ -37,10 +45,10 @@ -- elements might change but you can manipulate it by reading using 'folded' and -- reindexing it via 'setmap'. ----- > ghci> adjust members (+1) (fromList [1,2,3,4]--- > fromList [2,3,4,5]-members :: Setter IntSet IntSet Int Int-members = sets IntSet.map+-- >>> adjust setmapped (+1) (fromList [1,2,3,4])+-- fromList [2,3,4,5]+setmapped :: Setter IntSet IntSet Int Int+setmapped = sets IntSet.map  -- | Construct an 'IntSet' from a 'Getter', 'Fold', 'Traversal', 'Lens' or 'Iso'. --@@ -50,4 +58,4 @@ -- > setOf :: Lens a b Int d      -> a -> IntSet -- > setOf :: Traversal a b Int d -> a -> IntSet setOf :: Getting IntSet a b Int d -> a -> IntSet-setOf l = getConst . l (Const . IntSet.singleton)+setOf l = runAccessor . l (Accessor . IntSet.singleton)
src/Data/List/Lens.hs view
@@ -1,4 +1,6 @@ {-# LANGUAGE LiberalTypeSynonyms #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE Rank2Types #-} ----------------------------------------------------------------------------- -- |@@ -19,6 +21,8 @@   , _init   , interspersed   , intercalated+  -- * Traversals+  , traverseList   , traverseHead   , traverseTail   , traverseInit@@ -31,8 +35,8 @@  -- | A lens reading and writing to the head of a /non-empty/ list ----- > ghci> [1,2,3]^._head--- > 1+-- >>> [1,2,3]^._head+-- 1 _head :: Simple Lens [a] a _head _ [] = error "_head: empty list" _head f (a:as) = (:as) <$> f a@@ -40,14 +44,17 @@  -- | A lens reading and writing to the tail of a /non-empty/ list ----- > ghci> _tail <~ [3,4,5] $ [1,2]--- > [1,3,4,5]+-- >>> _tail .~ [3,4,5] $ [1,2]+-- [1,3,4,5] _tail :: Simple Lens [a] [a] _tail _ [] = error "_tail: empty list" _tail f (a:as) = (a:) <$> f as {-# INLINE _tail #-}  -- | A lens reading and writing to the last element of a /non-empty/ list+--+-- >>> [1,2]^._last+-- 2 _last :: Simple Lens [a] a _last _ []     = error "_last: empty list" _last f [a]    = return <$> f a@@ -55,6 +62,9 @@ {-# INLINE _last #-}  -- | A lens reading and replacing all but the a last element of a /non-empty/ list+--+-- >>> [1,2,3,4]^._init+-- [1,2,3] _init :: Simple Lens [a] [a] _init _ [] = error "_init: empty list" _init f as = (++ [Prelude.last as]) <$> f (Prelude.init as)@@ -62,8 +72,8 @@  -- | Obtain a version of the list with the supplied value interspersed. ----- > ghci> "abcde"^.interspersed ','--- > "a,b,c,d,e"+-- >>> "abcde"^.interspersed ','+-- "a,b,c,d,e" -- -- > xs^.interspersed a = intersperse a xs interspersed :: a -> Getter [a] [a]@@ -75,35 +85,67 @@ intercalated = to . intercalate {-# INLINE intercalated #-} +-- | Indexed traversal of a list. The position in the list is available as the index.+traverseList :: IndexedTraversal Int [a] [b] a b+traverseList = index $ go (0::Int) where+  go !n f (x:xs) = (:) <$> f n x <*> go (n + 1) f xs+  go _ _ [] = pure []+{-# INLINE traverseList #-}+ -- | The traversal for reading and writing to the head of a list --+-- The position of the head in the original list (0) is available as the index.+--+-- >>> traverseHead +~ 1 $ [1,2,3]+-- [2,2,3]+-- -- > traverseHead :: Applicative f => (a -> f a) -> [a] -> f [a]-traverseHead :: SimpleTraversal [a] a-traverseHead _ [] = pure []-traverseHead f (a:as) = (:as) <$> f a+traverseHead :: SimpleIndexedTraversal Int [a] a+traverseHead = index $ \f aas -> case aas of+  []     -> pure []+  (a:as) -> (:as) <$> f (0::Int) a {-# INLINE traverseHead #-}  -- | Traversal for editing the tail of a list. --+-- The position of each element /in the original list/ is available as the index.+--+-- >>> traverseTail +~ 1 $ [1,2,3]+-- [1,3,4]+-- -- > traverseTail :: Applicative f => (a -> f a) -> [a] -> f [a]-traverseTail :: SimpleTraversal [a] a-traverseTail _ [] = pure []-traverseTail f (a:as) = (a:) <$> traverse f as+traverseTail :: SimpleIndexedTraversal Int [a] a+traverseTail = index $ \f aas -> case aas of+  []     -> pure []+  (a:as) -> (a:) <$> traverseWithIndexOf traverseList (f . (+1)) as {-# INLINE traverseTail #-}  -- | Traverse the last element in a list. --+-- The position of the last element in the original list is available as the index.+--+-- >>> traverseLast +~ 1 $ [1,2,3]+-- [1,2,4]+-- -- > traverseLast :: Applicative f => (a -> f a) -> [a] -> f [a]-traverseLast :: SimpleTraversal [a] a-traverseLast _ []     = pure []-traverseLast f [a]    = return <$> f a-traverseLast f (a:as) = (a:) <$> traverseLast f as+traverseLast :: SimpleIndexedTraversal Int [a] a+traverseLast = index $ \f xs0 -> let+    go [a]    n = return <$> f n a+    go (a:as) n = (a:) <$> (go as $! n + 1)+    go []     _ = pure []+  in go xs0 (0::Int) where {-# INLINE traverseLast #-}  -- | Traverse all but the last element of a list --+-- The position of each element is available as the index.+--+-- >>> traverseInit +~ 1 $ [1,2,3]+-- [2,3,3]+-- -- > traverseInit :: Applicative f => (a -> f a) -> [a] -> f [a]-traverseInit :: SimpleTraversal [a] a-traverseInit _ [] = pure []-traverseInit f as = (++ [Prelude.last as]) <$> traverse f (Prelude.init as)+traverseInit :: SimpleIndexedTraversal Int [a] a+traverseInit = index $ \f aas -> case aas of+  [] -> pure []+  as -> (++ [Prelude.last as]) <$> traverseWithIndexOf traverseList f (Prelude.init as) {-# INLINE traverseInit #-}
src/Data/Map/Lens.hs view
@@ -1,5 +1,7 @@ {-# LANGUAGE Rank2Types #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LiberalTypeSynonyms #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-} ----------------------------------------------------------------------------- -- | -- Module      :  Data.Map.Lens@@ -12,20 +14,29 @@ ---------------------------------------------------------------------------- module Data.Map.Lens   ( at+  , traverseMap   , traverseAt   , traverseAtMin   , traverseAtMax   ) where  import Control.Applicative as Applicative-import Control.Lens+import Control.Lens.Type+import Control.Lens.Traversal+import Control.Lens.Indexed+import Control.Lens.Getter -- used by tests+import Control.Lens.Setter -- used by tests 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'. ----- > ghci> Map.fromList [("hello",12)] ^.at "hello"--- > Just 12+-- >>> 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 -> SimpleLens (Map k v) (Maybe v) at k f m = go <$> f (Map.lookup k m) where@@ -33,6 +44,10 @@   go (Just v') = Map.insert k v' m {-# 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)@@ -41,16 +56,20 @@ traverseAt k = at k . traverse {-# INLINE traverseAt #-} --- | Traverse the value at the minimum key in a Map-traverseAtMin :: SimpleTraversal (Map k v) v-traverseAtMin f m = case Map.minView m of-  Just (a, _) -> (\v -> Map.updateMin (const (Just v)) m) <$> f a-  Nothing     -> pure m+-- | Traverse the value at the minimum key in a Map.+--+-- The key of the minimum element is available as the index of the traversal.+traverseAtMin :: SimpleIndexedTraversal k (Map k v) v+traverseAtMin = index $ \f m -> case Map.minViewWithKey m of+  Just ((k, a), _) -> (\v -> Map.updateMin (const (Just v)) m) <$> f k a+  Nothing          -> pure m {-# INLINE traverseAtMin #-} --- | Traverse the value at the maximum key in a Map-traverseAtMax :: SimpleTraversal (Map k v) v-traverseAtMax f m = case Map.maxView m of-    Just (a, _) -> (\v -> Map.updateMax (const (Just v)) m) <$> f a-    Nothing     -> pure m+-- | Traverse the value at the maximum key in a Map.+--+-- The key of the maximum element is available as the index of the traversal.+traverseAtMax :: SimpleIndexedTraversal k (Map k v) v+traverseAtMax = index $ \f m -> case Map.maxViewWithKey m of+    Just ((k, a), _) -> (\v -> Map.updateMax (const (Just v)) m) <$> f k a+    Nothing          -> pure m {-# INLINE traverseAtMax #-}
src/Data/Pair/Lens.hs view
@@ -27,8 +27,6 @@  -- | This provides a 'Traversal' that checks a predicate on a key before -- allowing you to traverse into a value.-value :: (k -> Bool) -> Simple Traversal (k, v) v-value p f kv@(k,v)-  | p k       = (,) k <$> f v-  | otherwise = pure kv+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/Set/Lens.hs view
@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -fno-warn-unused-imports #-} ----------------------------------------------------------------------------- -- | -- Module      :  Data.Set.Lens@@ -10,18 +11,21 @@ ---------------------------------------------------------------------------- module Data.Set.Lens   ( contains-  , members+  , setmapped   , setOf   ) where  import Control.Applicative-import Control.Lens+import Control.Lens.Type+import Control.Lens.Setter+import Control.Lens.Getter+import Control.Lens.Fold -- For tests import Data.Set as Set  -- | This 'Lens' can be used to read, write or delete a member of a 'Set' ----- > ghci> contains 3 +~ False $ Set.fromList [1,2,3,4]--- > fromList [1,2,4]+-- >>> 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@@ -36,17 +40,20 @@ -- 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'. ----- > ghci> adjust members (+1) (fromList [1,2,3,4]--- > fromList [2,3,4,5]-members :: (Ord i, Ord j) => Setter (Set i) (Set j) i j-members = sets Set.map+-- >>> adjust setmapped (+1) (fromList [1,2,3,4])+-- fromList [2,3,4,5]+setmapped :: (Ord i, Ord j) => Setter (Set i) (Set j) i j+setmapped = sets Set.map  -- | Construct a set from a 'Getter', 'Fold', 'Traversal', 'Lens' or 'Iso'. --+-- >>> setOf (folded._2) [("hello",1),("world",2),("!!!",3)]+-- fromList [1,2,3]+-- -- > setOf ::          Getter a c        -> a -> Set c -- > setOf :: Ord c => Fold a c          -> a -> Set c -- > setOf ::          Iso a b c d       -> a -> Set c -- > setOf ::          Lens a b c d      -> a -> Set c -- > setOf :: Ord c => Traversal a b c d -> a -> Set c setOf :: Getting (Set c) a b c d -> a -> Set c-setOf l = getConst . l (Const . Set.singleton)+setOf l = runAccessor . l (Accessor . Set.singleton)
src/Data/Tree/Lens.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE FlexibleContexts #-} ----------------------------------------------------------------------------- -- | -- Module      :  Data.Tree.Lens@@ -5,7 +6,7 @@ -- License     :  BSD-style (see the file LICENSE) -- Maintainer  :  Edward Kmett <ekmett@gmail.com> -- Stability   :  provisional--- Portability :  portable+-- Portability :  MTPCs -- ---------------------------------------------------------------------------- @@ -16,12 +17,16 @@  import Control.Lens import Data.Functor+import Data.List.Lens import Data.Tree  -- | A 'Lens' that focuses on the root of a 'Tree'. root :: Simple Lens (Tree a) a root f (Node a as) = (`Node` as) <$> f a+{-# INLINE root #-} --- | A 'Traversal' of the direct descendants of the root of a 'Tree'.-children :: Simple Traversal (Tree a) (Tree a)-children f (Node a as) = Node a <$> traverse f as+-- | 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 <$> traverseWithIndexOf traverseList f as+{-# INLINE children #-}
src/GHC/Generics/Lens.hs view
@@ -1,3 +1,6 @@+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LiberalTypeSynonyms #-} ----------------------------------------------------------------------------- -- | -- Module      :  GHC.Generics.Lens@@ -9,17 +12,73 @@ -- ---------------------------------------------------------------------------- module GHC.Generics.Lens-  ( generic+  (+  -- * Conversion to/from generic+    generic   , generic1+  -- * Generic Traversal+  , every+  , GTraversal   ) where -import Control.Lens hiding (from, to)+import Control.Applicative+import Control.Lens.Iso hiding (from)+import Control.Lens.Traversal+import Control.Lens.Type+import Data.Maybe (fromJust)+import Data.Typeable import GHC.Generics  -- | Convert from the data type to its representation (or back)+--+-- >>> "hello"^.generic.from generic+-- "hello"+-- generic :: (Generic a, Generic b) => Iso a b (Rep a x) (Rep b y) generic = isos from to from to  -- | Convert from the data type to its representation (or back) generic1 :: (Generic1 f, Generic1 g) => Iso (f a) (g b) (Rep1 f a) (Rep1 g b) generic1 = isos from1 to1 from1 to1++-- | Traverse using GHC.Generics.+--+-- >>> allOf every (=="Hello") (1::Int,2::Double,(),"Hello",["Hello"])+-- True+--+-- >>> mapMOf_ every putStrLn ("hello",[(2 :: Int, "world!")])+-- hello+-- world!+every :: (Generic a, GTraversal (Rep a), Typeable b) => Simple Traversal a b+every = generic . everyr True++-- | Traversable generic data types. Used by 'every'.+class GTraversal f where+  everyr :: 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+    Just b  -> K1 . fromJust . cast <$> f b+    Nothing | rec       -> K1 <$> fmap generic (everyr 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++instance (GTraversal f, GTraversal g) => GTraversal (f :*: g) where+  everyr _ f (x :*: y) = (:*:) <$> everyr True f x <*> everyr 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++instance GTraversal a => GTraversal (M1 i c a) where+  everyr rec f (M1 x) = M1 <$> everyr rec f x++-- ?+instance (Traversable f, GTraversal g) => GTraversal (f :.: g) where+  everyr _ f (Comp1 fgp) = Comp1 <$> traverse (everyr True f) fgp+
src/Language/Haskell/TH/Lens.hs view
@@ -19,7 +19,10 @@   ) where  import Control.Applicative-import Control.Lens+import Control.Lens.Getter+import Control.Lens.Setter+import Control.Lens.Type+import Control.Lens.Traversal import Data.Map as Map hiding (toList,map) import Data.Map.Lens import Data.Maybe (fromMaybe)
+ test/doctests.hs view
@@ -0,0 +1,16 @@+module Main where++import Test.DocTest++main :: IO ()+main = doctest [+    "-isrc"+  , "-idist/build/autogen"+  , "-optP-include", "-optPdist/build/autogen/cabal_macros.h"+  , "src/Control/Lens.hs"+  , "src/Data/IntMap/Lens.hs"+  , "src/Data/IntSet/Lens.hs"+  , "src/Data/List/Lens.hs"+  , "src/Data/Map/Lens.hs"+  , "src/Data/Set/Lens.hs"+  ]