packages feed

lens 1.6 → 1.7

raw patch · 33 files changed

+1750/−892 lines, 33 filesdep +QuickCheckdep +glossdep +lensdep ~basedep ~transformersnew-component:exe:pong

Dependencies added: QuickCheck, gloss, lens, random

Dependency ranges changed: base, transformers

Files

+ README.markdown view
@@ -0,0 +1,25 @@+lens+====++[![Build Status](https://secure.travis-ci.org/ekmett/lens.png?branch=master)](http://travis-ci.org/ekmett/lens)++This package provides families of lenses, isomorphisms, folds, traversals, getters and setters.++These lenses are compatible with those from lens-family, lens-family-core and lens-family-th,+but they provide a great deal of additional flexibility in their composition.++Example+-------++    ghci> :m + Control.Lens Data.Text.Lens+    ghci> anyOf (traverse.text) (=='y') ["hello"^.packed, "goodbye"^.packed]+    True++Contact Information+-------------------++Contributions and bug reports are welcome!++Please feel free to contact me through github or on the #haskell IRC channel on irc.freenode.net.++-Edward Kmett
examples/Pong.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TemplateHaskell, Rank2Types #-}+{-# LANGUAGE TemplateHaskell, Rank2Types, NoMonomorphismRestriction #-}  import Control.Applicative ((<$>), (<*>)) import Control.Lens@@ -16,15 +16,18 @@  -- Some global constants -gameSize      = 300-windowSize    = 480-ballRadius    = 0.02-speedIncrease = 1.1-initialSpeed  = 0.5-paddleWidth   = 0.02-paddleHeight  = 0.3-paddleSpeed   = 1-textSize      = 0.001+gameSize        = 300+windowWidth     = 800+windowHeight    = 600+ballRadius      = 0.02+speedIncrease   = 1.2+losingAccuracy  = 0.7+winningAccuracy = 0.3+initialSpeed    = 0.6+paddleWidth     = 0.02+paddleHeight    = 0.3+paddleSpeed     = 1+textSize        = 0.001  -- Pure data type for representing the game state @@ -43,6 +46,12 @@ -- Some nice lenses to go with it makeLenses ''Pong +ahead (i, j) = i <= j++accuracy p+  | ahead (p^.score) = winningAccuracy+  | otherwise = losingAccuracy+ -- Renamed tuple lenses for enhanced clarity with points/vectors _x = _1 _y = _2@@ -89,7 +98,7 @@   p <- get    let paddleMovement = time * paddleSpeed-  let keyPressed key = p^.keys.contains (SpecialKey key)+      keyPressed key = p^.keys.contains (SpecialKey key)    -- Update the player's paddle based on keys   when (keyPressed KeyUp)   $ paddle1 += paddleMovement@@ -97,7 +106,9 @@    -- Calculate the optimal position   let optimal = hitPos (p^.ballPos) (p^.ballSpeed)-  let dist    = optimal - p^.paddle2+      acc     = accuracy p+      target  = optimal * acc + (p^.ballPos._y) * (1 - acc)+      dist    = target - p^.paddle2    -- Move the CPU's paddle towards this optimal position as needed   when (abs dist > paddleHeight/3) $@@ -125,16 +136,14 @@     ballSpeed._y %= negate    -- Check for collisions with paddles-  let { check paddle other =-    if y >= p^.paddle - paddleHeight/2 && y <= p^.paddle + paddleHeight/2-      then do-        ballSpeed._x   %= negate-        ballSpeed.both *= speedIncrease--      else do-        score.other += 1-        reset-  }+  let check paddle other+        | y >= p^.paddle - paddleHeight/2 && y <= p^.paddle + paddleHeight/2 = do+            ballSpeed._x   %= negate+            ballSpeed._y   += 3*(y - p^.paddle) -- add english+            ballSpeed.both *= speedIncrease+        | otherwise = do+          score.other += 1+          reset    when (x >=  edge) $ check paddle2 _1   when (x <= -edge) $ check paddle1 _2@@ -194,7 +203,7 @@   play display backColor fps world draw handle update    where-    display   = InWindow "Pong!" (windowSize, windowSize) (200, 200)+    display   = InWindow "Pong!" (windowWidth, windowHeight) (200, 200)     backColor = white     fps       = 120
− examples/Test.hs 
@@ -1,31 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}-module Test where--import Control.Lens-import Control.Lens.TH--data Foo a = Foo a-makeLenses ''Foo--data Bar a b c = Bar { _baz :: (a, b) }-makeLenses ''Bar--data Quux a b = Quux { _quaffle :: Int, _quartz :: Double }-makeLenses ''Quux--data Quark a = Qualified  { _gaffer :: a }-             | Unqualified { _gaffer :: a, blockingGaffer :: a }-makeLenses ''Quark--data LensCrafted a = Still { _still :: a }-                   | Works { _still :: a }-makeLenses ''LensCrafted--data Mono = Mono { _monoFoo :: Int, _monoBar :: Int }-makeClassy ''Mono--data Nucleosis = Nucleosis { _nuclear :: Mono }-makeClassy ''Nucleosis--instance HasMono Nucleosis where-  mono = nuclear
lens.cabal view
@@ -1,6 +1,6 @@ name:          lens category:      Data, Lenses-version:       1.6+version:       1.7 license:       BSD3 cabal-version: >= 1.8 license-file:  LICENSE@@ -44,8 +44,18 @@  build-type:    Simple tested-with:   GHC == 7.4.1-extra-source-files: .travis.yml examples/Pong.hs examples/Test.hs+extra-source-files:+  .travis.yml+  examples/*.hs+  test/*.hs+  README.markdown +-- Build examples+flag examples+  default: False+  manual: True+  + source-repository head   type: git   location: git://github.com/ekmett/lens.git@@ -60,12 +70,18 @@    exposed-modules: Control.Exception.Lens                    Control.Lens-                   Control.Lens.Internal-                   Control.Lens.Representable+                   Control.Lens.Action                    Control.Lens.Fold                    Control.Lens.Getter                    Control.Lens.Indexed+                   Control.Lens.IndexedGetter+                   Control.Lens.IndexedFold+                   Control.Lens.IndexedLens+                   Control.Lens.IndexedSetter+                   Control.Lens.IndexedTraversal+                   Control.Lens.Internal                    Control.Lens.Iso+                   Control.Lens.Representable                    Control.Lens.Setter                    Control.Lens.TH                    Control.Lens.Traversal@@ -121,12 +137,48 @@   ghc-options: -Wall -fwarn-tabs -O2 -fdicts-cheap -funbox-strict-fields   hs-source-dirs: src +-- Verify the results of the '>>>'s distributed throughout test-suite doctests-  type:            exitcode-stdio-1.0-  main-is:         doctests.hs+  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 -  build-depends:   base == 4.*,-                   doctest >= 0.8 && <= 0.9+-- Verify that Template Haskell expansion works+test-suite templates+  type: exitcode-stdio-1.0+  main-is: templates.hs+  build-depends:+    base == 4.*,+    lens == 1.7+  ghc-options: -Wall -Werror -threaded+  hs-source-dirs: test -  ghc-options:     -Wall -Werror -threaded-  hs-source-dirs:  test+-- Verify the properties of lenses with QuickCheck+test-suite properties+  type: exitcode-stdio-1.0+  main-is: properties.hs+  build-depends:+    base         == 4.*,+    lens         == 1.7,+    QuickCheck   >= 2.4 && < 2.6,+    transformers >= 0.3 && < 0.5+  ghc-options: -w -threaded+  hs-source-dirs: test++executable pong+  if !flag(examples)+    buildable: False++  build-depends:+    base       == 4.*,+    containers >= 0.4.2 && < 0.6,+    gloss      == 1.7.*,+    lens       == 1.7,+    mtl        >= 2.0.1 && < 2.2,+    random     == 1.0.*+  main-is: Pong.hs+  hs-source-dirs: examples
src/Control/Exception/Lens.hs view
@@ -5,7 +5,7 @@ -- License     :  BSD-style (see the file LICENSE) -- Maintainer  :  Edward Kmett <ekmett@gmail.com> -- Stability   :  provisional--- Portability :  portable+-- Portability :  Control.Exception -- ---------------------------------------------------------------------------- module Control.Exception.Lens@@ -20,8 +20,10 @@ -- Traverse the strongly typed 'Exception' contained in 'SomeException' where the type of your function matches -- the desired 'Exception'. ----- > traverseException :: (Applicative f, Exception a, Exception b)--- >                   => (a -> f b) -> SomeException -> f SomeException+-- @+-- traverseException :: ('Applicative' f, 'Exception' a, 'Exception' b)+--                   => (a -> f b) -> 'SomeException' -> f 'SomeException'+-- @ traverseException :: (Exception a, Exception b) => Traversal SomeException SomeException a b traverseException f e = case fromException e of   Just a -> toException <$> f a
src/Control/Lens.hs view
@@ -51,9 +51,15 @@   , module Control.Lens.Traversal   , module Control.Lens.Getter   , module Control.Lens.Setter+  , module Control.Lens.Action   , module Control.Lens.Fold   , module Control.Lens.Iso   , module Control.Lens.Indexed+  , module Control.Lens.IndexedFold+  , module Control.Lens.IndexedGetter+  , module Control.Lens.IndexedLens+  , module Control.Lens.IndexedTraversal+  , module Control.Lens.IndexedSetter   , module Control.Lens.Representable   , module Control.Lens.TH   ) where@@ -62,8 +68,14 @@ import Control.Lens.Traversal import Control.Lens.Getter import Control.Lens.Setter+import Control.Lens.Action import Control.Lens.Fold import Control.Lens.Iso import Control.Lens.Indexed+import Control.Lens.IndexedFold+import Control.Lens.IndexedGetter+import Control.Lens.IndexedLens+import Control.Lens.IndexedTraversal+import Control.Lens.IndexedSetter import Control.Lens.Representable import Control.Lens.TH
+ src/Control/Lens/Action.hs view
@@ -0,0 +1,146 @@+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Lens.Action+-- Copyright   :  (C) 2012 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  MTPCs, FDs, Rank2+--+----------------------------------------------------------------------------+module Control.Lens.Action+  (+  -- * Composable Actions+    Action+  , act+  , acts+  , perform+  , liftAct+  , (^!)++  -- * Folds with Effecs+  , MonadicFold++  -- * Implementation Details+  , Acting+  , Effective(..)+  , ineffective+  , Effect(..)+  ) where++import Control.Applicative+import Control.Applicative.Backwards+import Control.Lens.Getter+import Control.Lens.Iso+import Control.Monad+import Control.Monad.Trans.Class+import Data.Functor.Identity+import Data.Monoid++infixr 8 ^!++-- | An 'Action' is a 'Getter' enriched with access to a 'Monad' for side-effects.+--+-- Every 'Getter' can be used as an 'Action'+--+-- You can compose an 'Action' with another 'Action' using ('Prelude..') from the @Prelude@.+type Action m a c = forall f b r d. Effective m r f => (c -> f d) -> a -> f b++-- | A 'MonadicFold' is a 'Fold' enriched with access to a 'Monad' for side-effects.+--+-- Every 'Fold' can be used as a 'MonadicFold', that simply ignores the access to the 'Monad'.+--+-- You can compose a 'MonadicFold' with another 'MonadicFold' using ('Prelude..') from the @Prelude@.+type MonadicFold m a c = forall f b r d. (Effective m r f, Applicative f) => (c -> f d) -> a -> f b++-- | An 'Effective' 'Functor' ignores its argument and is isomorphic to a monad wrapped around a value.+--+-- That said, the monad is possibly rather unrelated to any 'Applicative' structure.+class (Monad m, Gettable f) => Effective m r f | f -> m r where+  effective :: Isomorphic k => k (m r) (f a)++-- | A convenient antonym that is used internally.+ineffective :: Effective m r f => Isomorphic k => k (f a) (m r)+ineffective = from effective+{-# INLINE ineffective #-}++instance Effective Identity r (Accessor r) where+  effective = isomorphic (Accessor . runIdentity) (Identity . runAccessor)+  {-# INLINE effective #-}+  {-# SPECIALIZE effective :: Identity r -> Accessor r a #-}+  {-# SPECIALIZE effective :: Isomorphism (Identity r) (Accessor r a) #-}++instance Effective m r f => Effective m (Dual r) (Backwards f) where+  effective = isomorphic (Backwards . effective . liftM getDual) (liftM Dual . ineffective . forwards)++-- | Wrap a monadic effect with a phantom type argument.+newtype Effect m r a = Effect { getEffect :: m r }++instance Monad m => Functor (Effect m r) where+  fmap _ (Effect m) = Effect m++instance (Monad m, Monoid r) => Monoid (Effect m r a) where+  mempty = Effect (return mempty)+  Effect ma `mappend` Effect mb = Effect (liftM2 mappend ma mb)++instance (Monad m, Monoid r) => Applicative (Effect m r) where+  pure _ = Effect (return mempty)+  Effect ma <*> Effect mb = Effect (liftM2 mappend ma mb)++instance Monad m => Gettable (Effect m r) where+  coerce (Effect m) = Effect m++instance Monad m => Effective m r (Effect m r) where+  effective = isomorphic Effect getEffect+  {-# SPECIALIZE effective :: Monad m => m r -> Effect m r a #-}+  {-# SPECIALIZE effective :: Monad m => Isomorphism (m r) (Effect m r a) #-}++-- | Used to evaluate an 'Action'.+type Acting m r a b c d = (c -> Effect m r d) -> a -> Effect m r b++-- | Perform an 'Action'.+--+-- > perform = flip (^!)+--+perform :: Monad m => Acting m c a b c d -> a -> m c+perform l = getEffect . l (Effect . return)+{-# INLINE perform #-}++-- | Perform an 'Action'+--+-- >>> import Control.Lens+--+-- >>> ["hello","world"]^!folded.act putStrLn+-- hello+-- world+--+(^!) :: Monad m => a -> Acting m c a b c d -> m c+a ^! l = getEffect (l (Effect . return) a)+{-# INLINE (^!) #-}++-- | Construct an 'Action' from a monadic side-effect+act :: Monad m => (a -> m c) -> Action m a c+act amc cfd a = effective (amc a >>= from effective . cfd)+{-# INLINE act #-}++-- | A self-running 'Action', analogous to 'Control.Monad.join'.+--+-- @'acts' = 'act' 'id'@+--+-- >>> import Control.Lens+--+-- >>> (1,"hello")^!_2.acts.to succ+-- "ifmmp"+acts :: Action m (m a) a+acts = act id+{-# INLINE acts #-}++-- | Apply a 'Monad' transformer to an 'Action'.+liftAct :: (MonadTrans t, Monad m) => Acting m c a b c d -> Action (t m) a c+liftAct l = act (lift . perform l)+{-# INLINE liftAct #-}
src/Control/Lens/Fold.hs view
@@ -1,10 +1,10 @@ {-# LANGUAGE Rank2Types #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LiberalTypeSynonyms #-}+{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE UndecidableInstances #-}------------------------------------------------------------------------------+---------------------------------------------------------------------------- -- | -- Module      :  Control.Lens.Fold -- Copyright   :  (C) 2012 Edward Kmett@@ -16,16 +16,16 @@ -- 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+-- Since we want to be able to work with monomorphic containers, we could generalize this signature to+-- @forall m. 'Monoid' m => (c -> m) -> a -> m@, and then decorate it with 'Accessor' to obtain -- -- @type 'Fold' a c = forall m b d. 'Monoid' m => 'Getting' m a b c d@ ----- In practice the type we use is slightly more complicated to allow for better error messages and--- for it to be transformed by certain 'Applicative' transformers.--- -- Every 'Getter' is a valid 'Fold' that simply doesn't use the 'Monoid' it is passed. --+-- But in practice the type we use is slightly more complicated to allow for better error messages +-- and for it to be transformed by certain 'Applicative' transformers.+-- -- Everything you can do with a 'Foldable' container, you can with with a 'Fold' and there are -- combinators that generalize the usual 'Foldable' operations here. ----------------------------------------------------------------------------@@ -33,9 +33,8 @@   (   -- * Folds     Fold-  , Furled(..)   -- ** Building Folds-  , folds+  --, folds   , folding   , folded   , unfolded@@ -96,29 +95,13 @@ -- -- 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+-- Unlike a 'Control.Lens.Traversal.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+type Fold a c = forall f b d. (Gettable f, Applicative f) => (c -> f d) -> a -> f b --- | 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 #-}+noEffect :: (Applicative f, Gettable f) => f a+noEffect = coerce $ pure ()+{-# INLINE noEffect #-}  -- | Obtain a 'Fold' by lifting an operation that returns a foldable result. --@@ -127,44 +110,52 @@ folding afc cgd = coerce . traverse_ cgd . afc {-# INLINE folding #-} +-- | A monoid in a monad as a monoid+newtype GA f a = GA { getGA :: f a }++instance (Gettable f, Applicative f) => Monoid (GA f a) where+  mempty = GA noEffect+  {-# INLINE mempty #-}+  GA fr `mappend` GA fs = GA (fr *> fs)+  {-# INLINE mappend #-}+ -- | Obtain a 'Fold' from any 'Foldable'.------ > folded = folds foldMap folded :: Foldable f => Fold (f c) c-folded = folds foldMap+folded f = coerce . getGA . foldMap (GA . f) {-# INLINE folded #-}  -- | Fold by repeating the input forever. ----- > repeat = toListOf repeated+-- @'repeat' = 'toListOf' 'repeated'@ repeated :: Fold a a-repeated f a = furled as where as = unfurled (f a) `mappend` as+repeated f a = as where as = f a *> as  -- | A fold that replicates its input @n@ times. ----- > replicate n = toListOf (replicated n)+-- @'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)+replicated n0 f a = go n0 where+  m = f a+  go 0 = noEffect+  go n = m *> 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+-- >>> import Control.Lens+-- >>> take 6 $ toListOf (cycled traverse) [1,2,3]+-- [1,2,3,1,2,3]+cycled :: (Applicative f, Gettable f) => LensLike f a b c d -> LensLike f a b c d+cycled l f a = as where as = l f a *> as  -- | Build a fold that unfolds its values from a seed. ----- > ghci> unfoldr = toListOf . unfolded+-- @'Prelude.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+    Nothing      -> noEffect {-# INLINE unfolded #-}  -- | @x ^. 'iterated' f@ Return an infinite fold of repeated applications of @f@ to @x@.@@ -175,38 +166,46 @@   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)+-- | Obtain a 'Fold' by filtering a 'Control.Lens.Type.Lens', 'Control.Lens.Iso.Iso', 'Getter', 'Fold' or 'Control.Lens.Traversal.Traversal'.+filtered :: (Gettable f, Applicative f) => (c -> Bool) -> LensLike f a b c d -> LensLike f a b c d+filtered p l f = l $ \c -> if p c then f c+                                  else noEffect {-# INLINE filtered #-} --- | This allows you to traverse the elements of a 'Traversal' or 'Fold' in the opposite order.+-- | This allows you to traverse the elements of a 'Control.Lens.Traversal.Traversal' or 'Fold' in the opposite order. ----- Note: 'backwards' should have no impact on a 'Getter' 'Setter', 'Lens' or 'Iso'.+-- Note: 'backwards' should have no impact on a 'Getter' 'Setter', 'Control.Lens.Type.Lens' or 'Control.Lens.Iso.Iso'. ----- To change the direction of an 'Iso', use 'from'.+-- To change the direction of an 'Control.Lens.Iso.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.+-- | Obtain a 'Fold' by taking elements from another 'Fold', 'Control.Lens.Type.Lens', 'Control.Lens.Iso.Iso', 'Getter' or 'Control.Lens.Traversal.Traversal' while a predicate holds. ----- > takeWhile p = toListOf (takingWhile p folded)+-- @'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+-- >>> toListOf (takingWhile (<=3) folded) [1..]+-- [1,2,3]+takingWhile :: (Gettable f, Applicative f)+            => (c -> Bool)+            -> Getting (Endo (f b)) a b c d+            -> LensLike f a b c d+takingWhile p l f = foldrOf l (\a r -> if p a then f a *> r else noEffect) noEffect {-# INLINE takingWhile #-} --- | Obtain a 'Fold' by dropping elements from another 'Fold', 'Lens', 'Iso', 'Getter' or 'Traversal' while a predicate holds.++-- | Obtain a 'Fold' by dropping elements from another 'Fold', 'Control.Lens.Type.Lens', 'Control.Lens.Iso.Iso', 'Getter' or 'Control.Lens.Traversal.Traversal' while a predicate holds. ----- > dropWhile p = toListOf (droppingWhile p folded)+-- @'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+-- >>> toListOf (droppingWhile (<=3) folded) [1..6]+-- [4,5,6]+droppingWhile :: (Gettable f, Applicative f)+              => (c -> Bool)+              -> Getting (Endo (f b)) a b c d+              -> LensLike f a b c d+droppingWhile p l f = foldrOf l (\a r -> if p a then r else f a *> r) noEffect {-# INLINE droppingWhile #-}  --------------------------@@ -214,9 +213,9 @@ --------------------------  -- |--- > foldMap = foldMapOf folded+-- @'Data.Foldable.foldMap' = 'foldMapOf' 'folded'@ ----- > foldMapOf = views+-- @'foldMapOf' = 'views'@ -- -- > foldMapOf ::             Getter a c        -> (c -> r) -> a -> r -- > foldMapOf :: Monoid r => Fold a c          -> (c -> r) -> a -> r@@ -228,9 +227,9 @@ {-# INLINE foldMapOf #-}  -- |--- > fold = foldOf folded+-- @'Data.Foldable.fold' = 'foldOf' 'folded'@ ----- > foldOf = view+-- @'foldOf' = 'view'@ -- -- > foldOf ::             Getter a m        -> a -> m -- > foldOf :: Monoid m => Fold a m          -> a -> m@@ -242,9 +241,9 @@ {-# INLINE foldOf #-}  -- |--- Right-associative fold of parts of a structure that are viewed through a 'Lens', 'Getter', 'Fold' or 'Traversal'.+-- Right-associative fold of parts of a structure that are viewed through a 'Control.Lens.Type.Lens', 'Getter', 'Fold' or 'Control.Lens.Traversal.Traversal'. ----- > foldr = foldrOf folded+-- @'Data.Foldable.foldr' = 'foldrOf' 'folded'@ -- -- > foldrOf :: Getter a c        -> (c -> e -> e) -> e -> a -> e -- > foldrOf :: Fold a c          -> (c -> e -> e) -> e -> a -> e@@ -256,9 +255,9 @@ {-# INLINE foldrOf #-}  -- |--- Left-associative fold of the parts of a structure that are viewed through a 'Lens', 'Getter', 'Fold' or 'Traversal'.+-- Left-associative fold of the parts of a structure that are viewed through a 'Control.Lens.Type.Lens', 'Getter', 'Fold' or 'Control.Lens.Traversal.Traversal'. ----- > foldl = foldlOf folded+-- @'Data.Foldable.foldl' = 'foldlOf' 'folded'@ -- -- > foldlOf :: Getter a c        -> (e -> c -> e) -> e -> a -> e -- > foldlOf :: Fold a c          -> (e -> c -> e) -> e -> a -> e@@ -270,7 +269,7 @@ {-# INLINE foldlOf #-}  -- |--- > toList = toListOf folded+-- @'Data.Foldable.toList' = 'toListOf' 'folded'@ -- -- > toListOf :: Getter a c        -> a -> [c] -- > toListOf :: Fold a c          -> a -> [c]@@ -282,7 +281,7 @@ {-# INLINE toListOf #-}  -- |--- > and = andOf folded+-- @'Data.Foldable.and' = 'andOf' 'folded'@ -- -- > andOf :: Getter a Bool       -> a -> Bool -- > andOf :: Fold a Bool         -> a -> Bool@@ -294,7 +293,7 @@ {-# INLINE andOf #-}  -- |--- > or = orOf folded+-- @'Data.Foldable.or' = 'orOf' 'folded'@ -- -- > orOf :: Getter a Bool        -> a -> Bool -- > orOf :: Fold a Bool          -> a -> Bool@@ -306,7 +305,7 @@ {-# INLINE orOf #-}  -- |--- > any = anyOf folded+-- @'Data.Foldable.any' = 'anyOf' 'folded'@ -- -- > anyOf :: Getter a c        -> (c -> Bool) -> a -> Bool -- > anyOf :: Fold a c          -> (c -> Bool) -> a -> Bool@@ -318,7 +317,7 @@ {-# INLINE anyOf #-}  -- |--- > all = allOf folded+-- @'Data.Foldable.all' = 'allOf' 'folded'@ -- -- > allOf :: Getter a c        -> (c -> Bool) -> a -> Bool -- > allOf :: Fold a c          -> (c -> Bool) -> a -> Bool@@ -330,7 +329,7 @@ {-# INLINE allOf #-}  -- |--- > product = productOf folded+-- @'Data.Foldable.product' = 'productOf' 'folded'@ -- -- > productOf ::          Getter a c        -> a -> c -- > productOf :: Num c => Fold a c          -> a -> c@@ -342,11 +341,12 @@ {-# INLINE productOf #-}  -- |--- > sum = sumOf folded+-- @'Data.Foldable.sum' = 'sumOf' 'folded'@ ----- > sumOf _1 :: (a, b) -> a--- > sumOf (folded._1) :: (Foldable f, Num a) => f (a, b) -> a+-- @'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@@ -362,11 +362,12 @@ -- -- When passed a 'Fold', 'traverseOf_' requires an 'Applicative'. ----- > traverse_ = traverseOf_ folded+-- @'Data.Foldable.traverse_' = 'traverseOf_' 'folded'@ ----- > traverseOf_ _2 :: Functor f => (c -> f e) -> (c1, c) -> f ()--- > traverseOf_ traverseLeft :: Applicative f => (a -> f b) -> Either a c -> f ()+-- @'traverseOf_' '_2' :: 'Functor' f => (c -> f e) -> (c1, c) -> f ()@ --+-- @'traverseOf_' 'Data.Either.Lens.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 ()@@ -379,7 +380,7 @@ {-# INLINE traverseOf_ #-}  -- |--- > for_ = forOf_ folded+-- @'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 ()@@ -391,7 +392,7 @@ {-# INLINE forOf_ #-}  -- |--- > sequenceA_ = sequenceAOf_ folded+-- @'sequenceA_' = 'sequenceAOf_' 'folded'@ -- -- > sequenceAOf_ :: Functor f     => Getter a (f ())        -> a -> f () -- > sequenceAOf_ :: Applicative f => Fold a (f ())          -> a -> f ()@@ -403,7 +404,7 @@ {-# INLINE sequenceAOf_ #-}  -- |--- > mapM_ = mapMOf_ folded+-- @'Data.Foldable.mapM_' = 'mapMOf_' 'folded'@ -- -- > mapMOf_ :: Monad m => Getter a c        -> (c -> m e) -> a -> m () -- > mapMOf_ :: Monad m => Fold a c          -> (c -> m e) -> a -> m ()@@ -419,7 +420,7 @@ {-# INLINE skip #-}  -- |--- > forM_ = forMOf_ folded+-- @'Data.Foldable.forM_' = 'forMOf_' 'folded'@ -- -- > forMOf_ :: Monad m => Getter a c        -> a -> (c -> m e) -> m () -- > forMOf_ :: Monad m => Fold a c          -> a -> (c -> m e) -> m ()@@ -431,7 +432,7 @@ {-# INLINE forMOf_ #-}  -- |--- > sequence_ = sequenceOf_ folded+-- @'Data.Foldable.sequence_' = 'sequenceOf_' 'folded'@ -- -- > sequenceOf_ :: Monad m => Getter a (m b)        -> a -> m () -- > sequenceOf_ :: Monad m => Fold a (m b)          -> a -> m ()@@ -444,7 +445,7 @@  -- | The sum of a collection of actions, generalizing 'concatOf'. ----- > asum = asumOf folded+-- @'asum' = 'asumOf' 'folded'@ -- -- > asumOf :: Alternative f => Getter a c        -> a -> f c -- > asumOf :: Alternative f => Fold a c          -> a -> f c@@ -457,7 +458,7 @@  -- | The sum of a collection of actions, generalizing 'concatOf'. ----- > msum = msumOf folded+-- @'msum' = 'msumOf' 'folded'@ -- -- > msumOf :: MonadPlus m => Getter a c        -> a -> m c -- > msumOf :: MonadPlus m => Fold a c          -> a -> m c@@ -469,7 +470,7 @@ {-# INLINE msumOf #-}  -- |--- > elem = elemOf folded+-- @'elem' = 'elemOf' 'folded'@ -- -- > elemOf :: Eq c => Getter a c        -> c -> a -> Bool -- > elemOf :: Eq c => Fold a c          -> c -> a -> Bool@@ -481,7 +482,7 @@ {-# INLINE elemOf #-}  -- |--- > notElem = notElemOf folded+-- @'notElem' = 'notElemOf' 'folded'@ -- -- > notElemOf :: Eq c => Getter a c        -> c -> a -> Bool -- > notElemOf :: Eq c => Fold a c          -> c -> a -> Bool@@ -493,7 +494,7 @@ {-# INLINE notElemOf #-}  -- |--- > concatMap = concatMapOf folded+-- @'concatMap' = 'concatMapOf' 'folded'@ -- -- > concatMapOf :: Getter a c        -> (c -> [e]) -> a -> [e] -- > concatMapOf :: Fold a c          -> (c -> [e]) -> a -> [e]@@ -505,7 +506,7 @@ {-# INLINE concatMapOf #-}  -- |--- > concat = concatOf folded+-- @'concat' = 'concatOf' 'folded'@ -- -- > concatOf :: Getter a [e]        -> a -> [e] -- > concatOf :: Fold a [e]          -> a -> [e]@@ -519,12 +520,13 @@ -- | -- Note: this can be rather inefficient for large containers. ----- > length = lengthOf folded+-- @'length' = 'lengthOf' 'folded'@ ----- > lengthOf _1 :: (a, b) -> Int--- > lengthOf _1 = 1--- > lengthOf (folded.folded) :: Foldable f => f (g a) -> Int+-- >>> lengthOf _1 ("hello",())+-- 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@@ -534,10 +536,10 @@ 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'.+-- | Perform a safe 'head' of a 'Fold' or 'Control.Lens.Traversal.Traversal' or retrieve 'Just' the result+-- from a 'Getter' or 'Control.Lens.Type.Lens'. ----- > listToMaybe . toList = headOf folded+-- @'Data.Maybe.listToMaybe' . 'toList' = 'headOf' 'folded'@ -- -- > headOf :: Getter a c        -> a -> Maybe c -- > headOf :: Fold a c          -> a -> Maybe c@@ -548,8 +550,8 @@ 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'.+-- | Perform a safe 'last' of a 'Fold' or 'Control.Lens.Traversal.Traversal' or retrieve 'Just' the result+-- from a 'Getter' or 'Control.Lens.Type.Lens'. -- -- > lastOf :: Getter a c        -> a -> Maybe c -- > lastOf :: Fold a c          -> a -> Maybe c@@ -561,18 +563,19 @@ {-# INLINE lastOf #-}  -- |--- Returns 'True' if this 'Fold' or 'Traversal' has no targets in the given container.+-- Returns 'True' if this 'Fold' or 'Control.Lens.Traversal.Traversal' has no targets in the given container. ----- Note: nullOf on a valid 'Iso', 'Lens' or 'Getter' should always return 'False'+-- Note: 'nullOf' on a valid 'Control.Lens.Iso.Iso', 'Control.Lens.Type.Lens' or 'Getter' should always return 'False' ----- > null = nullOf folded+-- @'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 _1 (1,2)+-- 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@@ -583,11 +586,11 @@ {-# INLINE nullOf #-}  -- |--- Obtain the maximum element (if any) targeted by a 'Fold' or 'Traversal'+-- Obtain the maximum element (if any) targeted by a 'Fold' or 'Control.Lens.Traversal.Traversal' ----- Note: maximumOf on a valid 'Iso', 'Lens' or 'Getter' will always return 'Just' a value.+-- Note: maximumOf on a valid 'Control.Lens.Iso.Iso', 'Control.Lens.Type.Lens' or 'Getter' will always return 'Just' a value. ----- > maximum = fromMaybe (error "empty") . maximumOf folded+-- @'maximum' = 'fromMaybe' ('error' "empty") . 'maximumOf' 'folded'@ -- -- > maximumOf ::          Getter a c        -> a -> Maybe c -- > maximumOf :: Ord c => Fold a c          -> a -> Maybe c@@ -599,11 +602,11 @@ {-# INLINE maximumOf #-}  -- |--- Obtain the minimum element (if any) targeted by a 'Fold' or 'Traversal'+-- Obtain the minimum element (if any) targeted by a 'Fold' or 'Control.Lens.Traversal.Traversal' ----- Note: minimumOf on a valid 'Iso', 'Lens' or 'Getter' will always return 'Just' a value.+-- Note: minimumOf on a valid 'Control.Lens.Iso.Iso', 'Control.Lens.Type.Lens' or 'Getter' will always return 'Just' a value. ----- > minimum = fromMaybe (error "empty") . minimumOf folded+-- @'minimum' = 'Data.Maybe.fromMaybe' ('error' "empty") . 'minimumOf' 'folded'@ -- -- > minimumOf ::          Getter a c        -> a -> Maybe c -- > minimumOf :: Ord c => Fold a c          -> a -> Maybe c@@ -615,10 +618,10 @@ {-# INLINE minimumOf #-}  -- |--- Obtain the maximum element (if any) targeted by a 'Fold', 'Traversal', 'Lens', 'Iso',+-- Obtain the maximum element (if any) targeted by a 'Fold', 'Control.Lens.Traversal.Traversal', 'Control.Lens.Type.Lens', 'Control.Lens.Iso.Iso', -- or 'Getter' according to a user supplied ordering. ----- > maximumBy cmp = fromMaybe (error "empty") . maximumByOf folded cmp+-- @'Data.Foldable.maximumBy' cmp = 'Data.Maybe.fromMaybe' ('error' "empty") . 'maximumByOf' 'folded' cmp@ -- -- > maximumByOf :: Getter a c        -> (c -> c -> Ordering) -> a -> Maybe c -- > maximumByOf :: Fold a c          -> (c -> c -> Ordering) -> a -> Maybe c@@ -632,7 +635,7 @@ {-# INLINE maximumByOf #-}  -- |--- Obtain the minimum element (if any) targeted by a 'Fold', 'Traversal', 'Lens', 'Iso'+-- Obtain the minimum element (if any) targeted by a 'Fold', 'Control.Lens.Traversal.Traversal', 'Control.Lens.Type.Lens', 'Control.Lens.Iso.Iso' -- or 'Getter' according to a user supplied ordering. -- -- > minimumBy cmp = fromMaybe (error "empty") . minimumByOf folded cmp@@ -648,7 +651,7 @@   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),+-- | The 'findOf' function takes a 'Control.Lens.Type.Lens' (or 'Control.Lens.Getter.Getter', 'Control.Lens.Iso.Iso', 'Control.Lens.Fold.Fold', or 'Control.Lens.Traversal.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. --@@ -669,9 +672,9 @@ -- to lenses and structures such that the lens views at least one element of -- the structure. ----- > foldr1Of l f = Prelude.foldr1 f . toListOf l+-- @'foldr1Of' l f = 'Prelude.foldr1' f . 'toListOf' l@ ----- > foldr1 = foldr1Of folded+-- @'Data.Foldable.foldr1' = 'foldr1Of' 'folded'@ -- -- > foldr1Of :: Getter a c        -> (c -> c -> c) -> a -> c -- > foldr1Of :: Fold a c          -> (c -> c -> c) -> a -> c@@ -688,9 +691,9 @@ -- | 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+-- @'foldl1Of' l f = 'Prelude.foldl1Of' l f . 'toList'@ ----- > foldl1 = foldl1Of folded+-- @'Data.Foldable.foldl1' = 'foldl1Of' 'folded'@ -- -- > foldl1Of :: Getter a c        -> (c -> c -> c) -> a -> c -- > foldl1Of :: Fold a c          -> (c -> c -> c) -> a -> c@@ -705,7 +708,7 @@  -- | Strictly fold right over the elements of a structure. ----- > foldr' = foldrOf' folded+-- @'Data.Foldable.foldr'' = 'foldrOf'' 'folded'@ -- -- > foldrOf' :: Getter a c        -> (c -> e -> e) -> e -> a -> e -- > foldrOf' :: Fold a c          -> (c -> e -> e) -> e -> a -> e@@ -719,7 +722,7 @@  -- | Fold over the elements of a structure, associating to the left, but strictly. ----- > foldl' = foldlOf' folded+-- @'Data.Foldable.foldl'' = 'foldlOf'' 'folded'@ -- -- > foldlOf' :: Getter a c          -> (e -> c -> e) -> e -> a -> e -- > foldlOf' :: Fold a c            -> (e -> c -> e) -> e -> a -> e@@ -734,7 +737,7 @@ -- | Monadic fold over the elements of a structure, associating to the right, -- i.e. from right to left. ----- > foldrM = foldrMOf folded+-- @'Data.Foldable.foldrM' = 'foldrMOf' 'folded'@ -- -- > foldrMOf :: Monad m => Getter a c        -> (c -> e -> m e) -> e -> a -> m e -- > foldrMOf :: Monad m => Fold a c          -> (c -> e -> m e) -> e -> a -> m e@@ -751,7 +754,7 @@ -- | Monadic fold over the elements of a structure, associating to the left, -- i.e. from left to right. ----- > foldlM = foldlMOf folded+-- @'Data.Foldable.foldlM' = 'foldlMOf' 'folded'@ -- -- > foldlMOf :: Monad m => Getter a c        -> (e -> c -> m e) -> e -> a -> m e -- > foldlMOf :: Monad m => Fold a c          -> (e -> c -> m e) -> e -> a -> m e
src/Control/Lens/Getter.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE Rank2Types #-}-{-# OPTIONS_GHC -fno-warn-unused-imports #-} ----------------------------------------------------------------------------- -- | -- Module      :  Control.Lens.Getter@@ -13,18 +12,19 @@ -- 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+-- @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+-- @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 --+-- @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.+-- 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.@@ -54,10 +54,8 @@ 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 ^$@@ -69,17 +67,19 @@ -- | 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.+-- Unlike a 'Control.Lens.Type.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. In fact, it is isomorphic to an arbitrary function from @(a -> c)@. ----- Moreover, a 'Getter' can be used directly as a 'Fold', since it just ignores the 'Monoid'.+-- Moreover, a 'Getter' can be used directly as a 'Control.Lens.Fold.Fold', since it just ignores the 'Applicative'. 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+-- @'to' f . 'to' g = 'to' (g . f)@ --+-- @a '^.' 'to' f = f a@+--+-- >>> import Control.Lens -- >>> (0, -5)^._2.to abs -- 5 to :: (a -> c) -> Getter a c@@ -87,23 +87,31 @@ {-# INLINE to #-}  -- |--- Most 'Getter' combinators are able to be used with both a 'Getter' or a 'Fold' in+-- Most 'Getter' combinators are able to be used with both a 'Getter' or a 'Control.Lens.Fold.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+-- extract with 'Const'. To be compatible with 'Control.Lens.Type.Lens', 'Control.Lens.Traversal.Traversal' and 'Control.Lens.Iso.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'.+-- 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 'Control.Lens.Fold.Fold' (or 'Control.Lens.Traversal.Traversal'), otherwise you can only pass this a+-- 'Getter' or 'Control.Lens.Type.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+-- | Generalizing 'Const' so we can apply simple 'Applicative' transformations to it -- and so we can get nicer error messages+--+-- A 'Gettable' 'Functor' ignores its argument, which it carries solely as a phantom+-- type parameter.+--+-- To ensure this, it is required to satisfy:+--+-- > id = fmap f = coerce class Functor f => Gettable f where+  -- | Replace the phantom type argument.   coerce :: f a -> f b  instance Gettable (Const r) where@@ -115,14 +123,19 @@ instance (Functor f, Gettable g) => Gettable (Compose f g) where   coerce = Compose . fmap coerce . getCompose +-- | This instance is a lie, but it is a useful lie. instance Gettable f => Gettable (ElementOf f) where   coerce (ElementOf m) = ElementOf $ \i -> case m i of-    Searching _ _ -> NotFound "coerced while searching"+    Searching _ _ -> NotFound "coerced while searching" -- er...     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'.+-- | Used instead of 'Const' to report+--+-- @No instance of ('Control.Lens.Setter.Settable' 'Accessor')@+--+-- when the user attempts to misuse a 'Control.Lens.Setter.Setter' as a 'Getter',+-- rather than a monolithic unification error. newtype Accessor r a = Accessor { runAccessor :: r }  instance Functor (Accessor r) where@@ -139,75 +152,87 @@ -- 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.+-- | View the value pointed to by a 'Getter', 'Control.Lens.Iso.Iso' or 'Control.Lens.Type.Lens' or the result of folding over+-- all the results of a 'Control.Lens.Fold.Fold' or 'Control.Lens.Traversal.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' . 'to' = 'id'@ --+-- >>> import Control.Lens -- >>> 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 ::             'Getter' a c          -> a -> c+-- view :: 'Monoid' m => 'Control.Lens.Fold.Fold' a m            -> a -> m+-- view ::             'Control.Lens.Iso.Iso' a b c d         -> a -> c+-- view ::             'Control.Lens.Type.Lens' a b c d        -> a -> c+-- view :: 'Monoid' m => 'Control.Lens.Traversal.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'.+-- | View the value of a 'Getter', 'Control.Lens.Iso.Iso', 'Control.Lens.Type.Lens' or the result of folding over the+-- result of mapping the targets of a 'Control.Lens.Fold.Fold' or 'Control.Lens.Traversal.Traversal'. -- -- It may be useful to think of 'views' as having these more restrictive signatures: --+-- >>> import Control.Lens -- >>> 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 ::             'Getter' a c          -> (c -> d) -> a -> d+-- views :: 'Monoid' m => 'Control.Lens.Fold.Fold' a c            -> (c -> m) -> a -> m+-- views ::             'Control.Lens.Iso.Iso' a b c d         -> (c -> d) -> a -> d+-- views ::             'Control.Lens.Type.Lens' a b c d        -> (c -> d) -> a -> d+-- views :: 'Monoid' m => 'Control.Lens.Traversal.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.+-- | View the value pointed to by a 'Getter', 'Control.Lens.Iso.Iso' or 'Control.Lens.Type.Lens' or the result of folding over+-- all the results of a 'Control.Lens.Fold.Fold' or 'Control.Lens.Traversal.Traversal' that points at a monoidal values. -- -- This is the same operation as 'view', only infix. --+-- >>> import Control.Lens -- >>> _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+-- @+-- (^$) ::             'Getter' a c          -> a -> c+-- (^$) :: 'Monoid' m => 'Control.Lens.Fold.Fold' a m            -> a -> m+-- (^$) ::             'Control.Lens.Iso.Iso' a b c d         -> a -> c+-- (^$) ::             'Control.Lens.Type.Lens' a b c d        -> a -> c+-- (^$) :: 'Monoid' m => 'Control.Lens.Traversal.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.+-- | View the value pointed to by a 'Getter' or 'Control.Lens.Type.Lens' or the result of folding over+-- all the results of a 'Control.Lens.Fold.Fold' or 'Control.Lens.Traversal.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..)+-- performed with ('Prelude..') --+-- >>> :m + Data.Complex Control.Lens -- >>> ((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 -> 'Getter' a c          -> c+-- (^.) :: 'Monoid' m => a -> 'Control.Lens.Fold.Fold' a m            -> m+-- (^.) ::             a -> 'Control.Lens.Iso.Iso' a b c d         -> c+-- (^.) ::             a -> 'Control.Lens.Type.Lens' a b c d        -> c+-- (^.) :: 'Monoid' m => a -> 'Control.Lens.Traversal.Traversal' a b m d   -> m+-- @ (^.) :: a -> Getting c a b c d -> c a ^. l = runAccessor (l Accessor a) {-# INLINE (^.) #-}@@ -217,31 +242,31 @@ ------------------------------------------------------------------------------  -- |--- 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 the target of a 'Control.Lens.Type.Lens', 'Control.Lens.Iso.Iso' or 'Getter' in the current state, or use a+-- summary of a 'Control.Lens.Fold.Fold' or 'Control.Lens.Traversal.Traversal' that points to a monoidal value. ----- > query :: MonadReader a m => ((c -> Const c d) -> a -> Const c b) -> m c+-- @+-- query :: 'MonadReader' a m             => 'Getter' a c        -> m c+-- query :: ('MonadReader' a m, 'Monoid' c) => 'Control.Lens.Fold.Fold' a c          -> m c+-- query :: 'MonadReader' a m             => 'Control.Lens.Iso.Iso' a b c d       -> m c+-- query :: 'MonadReader' a m             => 'Control.Lens.Type.Lens' a b c d      -> m c+-- query :: ('MonadReader' a m, 'Monoid' c) => 'Control.Lens.Traversal.Traversal' a b c d -> 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+-- Use the target of a 'Control.Lens.Type.Lens', 'Control.Lens.Iso.Iso' or 'Getter' in the current state, or use a+-- summary of a 'Control.Lens.Fold.Fold' or 'Control.Lens.Traversal.Traversal' that points to a monoidal value. ----- > queries :: MonadReader a m => ((c -> Const e d) -> a -> Const e b) -> (c -> e) -> m e+-- @+-- queries :: 'MonadReader' a m             => 'Getter' a c        -> (c -> e) -> m e+-- queries :: ('MonadReader' a m, 'Monoid' c) => 'Control.Lens.Fold.Fold' a c          -> (c -> e) -> m e+-- queries :: 'MonadReader' a m             => 'Control.Lens.Iso.Iso' a b c d       -> (c -> e) -> m e+-- queries :: 'MonadReader' a m             => 'Control.Lens.Type.Lens' a b c d      -> (c -> e) -> m e+-- queries :: ('MonadReader' a m, 'Monoid' c) => 'Control.Lens.Traversal.Traversal' a b c d -> (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 #-}@@ -251,29 +276,31 @@ ------------------------------------------------------------------------------  -- |--- 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 the target of a 'Control.Lens.Type.Lens', 'Control.Lens.Iso.Iso', or 'Getter' in the current state, or use a+-- summary of a 'Control.Lens.Fold.Fold' or 'Control.Lens.Traversal.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             => 'Getter' a c          -> m c+-- use :: ('MonadState' a m, 'Monoid' r) => 'Control.Lens.Fold.Fold' a r            -> m r+-- use :: 'MonadState' a m             => 'Control.Lens.Iso.Iso' a b c d         -> m c+-- use :: 'MonadState' a m             => 'Control.Lens.Type.Lens' a b c d        -> m c+-- use :: ('MonadState' a m, 'Monoid' r) => 'Control.Lens.Traversal.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.+-- Use the target of a 'Control.Lens.Type.Lens', 'Control.Lens.Iso.Iso' or 'Getter' in the current state, or use a+-- summary of a 'Control.Lens.Fold.Fold' or 'Control.Lens.Traversal.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             => 'Getter' a c        -> (c -> e) -> m e+-- uses :: ('MonadState' a m, 'Monoid' r) => 'Control.Lens.Fold.Fold' a c          -> (c -> r) -> m r+-- uses :: 'MonadState' a m             => 'Control.Lens.Type.Lens' a b c d      -> (c -> e) -> m e+-- uses :: 'MonadState' a m             => 'Control.Lens.Iso.Iso' a b c d       -> (c -> e) -> m e+-- uses :: ('MonadState' a m, 'Monoid' r) => 'Control.Lens.Traversal.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
@@ -12,6 +12,7 @@ -- Stability   :  provisional -- Portability :  rank 2 types, MPTCs, TFs, flexible --+-- Combinators for working with 'Indexed' functions. ---------------------------------------------------------------------------- module Control.Lens.Indexed   (@@ -19,67 +20,22 @@     Indexed(..)   , Indexable   , Index(..)-  , (.@)+  , (<.>), (<.), (.>)   , icompose   , reindex--  -- * Indexed Setter-  , IndexedSetter-  , imapOf-  , (%@)--  -- * Indexed Traversals-  , IndexedTraversal-  , itraverseOf-  , iforOf-  , imapMOf-  , iforMOf-  , imapAccumROf-  , imapAccumLOf--  -- * Indexed Folds-  , IndexedFold-  , IndexedFolding-  , ifoldMapOf-  , ifoldrOf-  , ifoldlOf-  , ianyOf-  , iallOf-  , itraverseOf_-  , iforOf_-  , imapMOf_-  , iforMOf_-  , iconcatMapOf-  -- , imaximumByOf , iminimumByOf , ifindOf-  , ifoldrOf'-  , ifoldlOf'-  , ifoldrMOf-  , ifoldlMOf--  -- * Simple-  , SimpleIndexedTraversal-  , SimpleIndexedSetter   ) where -import Control.Applicative-import Control.Applicative.Backwards-import Control.Lens.Getter-import Control.Lens.Internal-import Control.Lens.Setter-import Control.Lens.Type-import Control.Monad-import Control.Monad.State.Class as State-import Control.Monad.Trans.State.Lazy as Lazy-import Data.Monoid+infixr 9 <.>, <., .>  -- | Permit overloading of function application for things that also admit a notion of a key or index. --- | Provides overloading for indexed functions.+-- | Provides overloading for 'Indexed' functions. class Indexed i k where-  -- | Build a function from an indexed function+  -- | Build a function from an 'Indexed' function   index :: ((i -> a) -> b) -> k a b --- | Type alias for passing around polymorphic indexed functions.+-- | Type alias for passing around polymorphic 'Indexed' functions that can be called 'withIndex' or+-- directly as a function type Indexable i a b = forall k. Indexed i k => k a b  instance Indexed i (->) where@@ -87,7 +43,7 @@   {-# INLINE index #-}  -- | A function with access to a index. This constructor may be useful when you need to store--- a 'HasIndex'.+-- a 'Indexable' in a container to avoid @ImpredicativeTypes@. newtype Index i a b = Index { withIndex :: (i -> a) -> b }  -- | Using an equality witness to avoid potential overlapping instances@@ -96,272 +52,42 @@   index = Index   {-# INLINE index #-} +-- | Compose an 'Indexed' function with a non-indexed function.+--+-- Mnemonically, the @<@ points to the index we want to preserve.+(<.)  :: Indexed i k => Index i b c -> (a -> b) -> k a c+Index ibc <. ab = index $ \ia -> ibc (ab . ia)+{-# INLINE (<.) #-}+{-# SPECIALIZE (<.) :: Index i b c -> (a -> b) -> a -> c #-}+{-# SPECIALIZE (<.) :: Index i b c -> (a -> b) -> Index i a c #-}++-- | Compose a non-indexed function with an 'Indexed' function.+--+-- Mnemonically, the @>@ points to the index we want to preserve.+(.>)  :: Indexed i k => (b -> c) -> Index i a b -> k a c+bc .> Index iab = index (bc . iab)+{-# INLINE (.>) #-}+{-# SPECIALIZE (.>) :: (b -> c) -> Index i a b -> a -> c #-}+{-# SPECIALIZE (.>) :: (b -> c) -> Index i a b -> Index i a c #-}+ -- | 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 #-}+{-# SPECIALIZE reindex :: (i -> j) -> Index i a b -> Index j 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 = icompose (,) 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+--+-- Mnemonically, the @<@ and @>@ points to the fact that we want to preserve the indices.+(<.>) :: Indexed (i, j) k => Index i b c -> Index j a b -> k a c+f <.> g = icompose (,) f g+{-# INLINE (<.>) #-}+{-# SPECIALIZE (<.>) :: Index i b c -> Index j a b -> a -> c #-}+{-# SPECIALIZE (<.>) :: Index i b c -> Index j a b -> Index (i,j) a c #-} --- | Composition of indexed functions with a user supplied function for combining indexs+-- | Composition of 'Indexed' functions with a user supplied function for combining indexs icompose :: Indexed k r => (i -> j -> k) -> Index i b c -> Index j a b -> r a c icompose ijk (Index ibc) (Index jab) = index $ \ka -> ibc $ \i -> jab $ \j -> ka (ijk i j) {-# INLINE icompose #-} {-# SPECIALIZE icompose :: (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)---- |------ > ifoldMapOf :: Monoid m => IndexedFold i a c          -> (i -> c -> m) -> a -> m--- > ifoldMapOf :: Monoid m => IndexedTraversal i a b c d -> (i -> c -> m) -> a -> m-ifoldMapOf :: IndexedFolding i m a b c d -> (i -> c -> m) -> a -> m-ifoldMapOf l f = runAccessor . withIndex l (\i -> Accessor . f i)-{-# INLINE ifoldMapOf #-}---- |--- Right-associative fold of parts of a structure that are viewed through a 'Lens', 'Getter', 'Fold' or 'Traversal'.------ > ifoldrOf :: IndexedFold i a c          -> (i -> c -> e -> e) -> e -> a -> e--- > ifoldrOf :: IndexedTraversal i a b c d -> (i -> c -> e -> e) -> e -> a -> e-ifoldrOf :: IndexedFolding i (Endo e) a b c d -> (i -> c -> e -> e) -> e -> a -> e-ifoldrOf l f z t = appEndo (ifoldMapOf l (\i -> Endo . f i) t) z-{-# INLINE ifoldrOf #-}---- |--- Left-associative fold of the parts of a structure that are viewed through a 'Lens', 'Getter', 'Fold' or 'Traversal'.------ > foldl = foldlOf folded------ > ifoldlOf :: IndexedFold i a c          -> (i -> e -> c -> e) -> e -> a -> e--- > ifoldlOf :: IndexedTraversal i a b c d -> (i -> e -> c -> e) -> e -> a -> e-ifoldlOf :: IndexedFolding i (Dual (Endo e)) a b c d -> (i -> e -> c -> e) -> e -> a -> e-ifoldlOf l f z t = appEndo (getDual (ifoldMapOf l (\i -> Dual . Endo . flip (f i)) t)) z-{-# INLINE ifoldlOf #-}----- |--- > ianyOf :: IndexedFold i a c          -> (i -> c -> Bool) -> a -> Bool--- > ianyOf :: IndexedTraversal i a b c d -> (i -> c -> Bool) -> a -> Bool-ianyOf :: IndexedFolding i Any a b c d -> (i -> c -> Bool) -> a -> Bool-ianyOf l f = getAny . ifoldMapOf l (\i -> Any . f i)-{-# INLINE ianyOf #-}---- |--- > iallOf :: IndexedFold i a c          -> (i -> c -> Bool) -> a -> Bool--- > iallOf :: IndexedTraversal i a b c d -> (i -> c -> Bool) -> a -> Bool-iallOf :: IndexedFolding i All a b c d -> (i -> c -> Bool) -> a -> Bool-iallOf l f = getAll . ifoldMapOf l (\i -> All . f i)-{-# INLINE iallOf #-}---- |--- > itraverseOf_ :: Applicative f => IndexedFold i a c          -> (i -> c -> f e) -> a -> f ()--- > itraverseOf_ :: Applicative f => IndexedTraversal i a b c d -> (i -> c -> f e) -> a -> f ()-itraverseOf_ :: Functor f => IndexedFolding i (Traversed f) a b c d -> (i -> c -> f e) -> a -> f ()-itraverseOf_ l f = getTraversed . ifoldMapOf l (\i -> Traversed . void . f i)-{-# INLINE itraverseOf_ #-}---- |--- > iforOf_ :: Applicative f => IndexedFold i a c          -> a -> (i -> c -> f e) -> f ()--- > iforOf_ :: Applicative f => IndexedTraversal i a b c d -> a -> (i -> c -> f e) -> f ()-iforOf_ :: Functor f => IndexedFolding i (Traversed f) a b c d -> a -> (i -> c -> f e) -> f ()-iforOf_ = flip . itraverseOf_-{-# INLINE iforOf_ #-}---- |--- > imapMOf_ :: Monad m => IndexedFold i a c          -> (i -> c -> m e) -> a -> m ()--- > imapMOf_ :: Monad m => IndexedTraversal i a b c d -> (i -> c -> m e) -> a -> m ()-imapMOf_ :: Monad m => IndexedFolding i (Sequenced m) a b c d -> (i -> c -> m e) -> a -> m ()-imapMOf_ l f = getSequenced . ifoldMapOf l (\i -> Sequenced . liftM skip . f i)-{-# INLINE imapMOf_ #-}--skip :: a -> ()-skip _ = ()-{-# INLINE skip #-}---- |--- > iforMOf_ :: Monad m => IndexedFold i a c          -> a -> (i -> c -> m e) -> m ()--- > iforMOf_ :: Monad m => IndexedTraversal i a b c d -> a -> (i -> c -> m e) -> m ()-iforMOf_ :: Monad m => IndexedFolding i (Sequenced m) a b c d -> a -> (i -> c -> m e) -> m ()-iforMOf_ = flip . imapMOf_-{-# INLINE iforMOf_ #-}---- |--- > iconcatMapOf :: IndexedFold i a c          -> (i -> c -> [e]) -> a -> [e]--- > iconcatMapOf :: IndexedTraversal i a b c d -> (i -> c -> [e]) -> a -> [e]-iconcatMapOf :: IndexedFolding i [e] a b c d -> (i -> c -> [e]) -> a -> [e]-iconcatMapOf l ices = runAccessor . withIndex l (\i -> Accessor . ices i)-{-# INLINE iconcatMapOf #-}--{---- |--- Obtain the maximum element (if any) targeted by an 'IndexedFold' or 'IndexedTraversal'--- according to a user supplied ordering with access to the indices, returning the index and result of the winning entry------ > imaximumByOf :: IndexedFold a c          -> (i -> i -> c -> c -> Ordering) -> a -> Maybe (i, c)--- > imaximumByOf :: IndexedTraversal a b c d -> (i -> i -> c -> c -> Ordering) -> a -> Maybe (i, c)-imaximumByOf :: IndexedFolding i (Endo (Maybe c)) a b c d -> (i -> i -> c -> c -> Ordering) -> a -> Maybe (i, c)-imaximumByOf l cmp = ifoldrOf l step Nothing where-  step i a Nothing  = Just (i, a)-  step i a (Just (j, b)) = Just $! if cmp i j a b == GT then (i, a) else (j, b)-{-# INLINE imaximumByOf #-}---- |--- Obtain the minimum element (if any) targeted by an 'IndexedFold' or 'IndexedTraversal'--- according to a user supplied ordering with access to the indices, returning the index and result of the winning entry------ > iminimumByOf :: IndexedFold a c          -> (i -> i -> c -> c -> Ordering) -> a -> Maybe (i, c)--- > iminimumByOf :: IndexedTraversal a b c d -> (i -> i -> c -> c -> Ordering) -> a -> Maybe (i, c)-iminimumByOf :: IndexedFolding i (Endo (Maybe c)) a b c d -> (i -> i -> c -> c -> Ordering) -> a -> Maybe (i, c)-iminimumByOf l cmp = ifoldrOf l step Nothing where-  step i a Nothing  = Just (i, a)-  step i a (Just (j, b)) = Just $! if cmp i j a b == GT then (j, b) else (i, a)-{-# INLINE iminimumByOf #-}---- | The 'findOf' function takes an IndexedFold or IndexedTraversal, a predicate,--- a structure and returns the leftmost element of the structure--- matching the predicate, or 'Nothing' if there is no such element.------ > ifindOf :: IndexedFold a c          -> (i -> c -> Bool) -> a -> Maybe (i, c)--- > ifindOf :: IndexedTraversal a b c d -> (i -> c -> Bool) -> a -> Maybe (i, c)-ifindOf :: IndexedFolding i (First c) a b c d -> (i -> c -> Bool) -> a -> Maybe (i, c)-ifindOf l p = getFirst . ifoldMapOf l step where-  step i c-    | p i c     = First (Just (i, c))-    | otherwise = First Nothing-{-# INLINE ifindOf #-}--}---- | Strictly fold right over the elements of a structure with an index.------ > ifoldrOf' :: IndexedFold i a c          -> (i -> c -> e -> e) -> e -> a -> e--- > ifoldrOf' :: IndexedTraversal i a b c d -> (i -> c -> e -> e) -> e -> a -> e-ifoldrOf' :: IndexedFolding i (Dual (Endo (e -> e))) a b c d -> (i -> c -> e -> e) -> e -> a -> e-ifoldrOf' l f z0 xs = ifoldlOf l f' id xs z0-  where f' i k x z = k $! f i x z-{-# INLINE ifoldrOf' #-}---- | Fold over the elements of a structure with an index, associating to the left, but strictly.------ > ifoldlOf' :: IndexedFold i a c            -> (i -> e -> c -> e) -> e -> a -> e--- > ifoldlOf' :: IndexedTraversal i a b c d   -> (i -> e -> c -> e) -> e -> a -> e-ifoldlOf' :: IndexedFolding i (Endo (e -> e)) a b c d -> (i -> e -> c -> e) -> e -> a -> e-ifoldlOf' l f z0 xs = ifoldrOf l f' id xs z0-  where f' i x k z = k $! f i z x-{-# INLINE ifoldlOf' #-}---- | Monadic fold right over the elements of a structure with an index.------ > ifoldrMOf :: Monad m => IndexedFold i a c          -> (i -> c -> e -> m e) -> e -> a -> e--- > ifoldrMOf :: Monad m => IndexedTraversal i a b c d -> (i -> c -> e -> m e) -> e -> a -> e-ifoldrMOf :: Monad m => IndexedFolding i (Dual (Endo (e -> m e))) a b c d -> (i -> c -> e -> m e) -> e -> a -> m e-ifoldrMOf l f z0 xs = ifoldlOf l f' return xs z0-  where f' i k x z = f i x z >>= k-{-# INLINE ifoldrMOf #-}---- | Monadic fold over the elements of a structure with an index, associating to the left.------ > ifoldlOf' :: Monad m => IndexedFold i a c            -> (i -> e -> c -> m e) -> e -> a -> e--- > ifoldlOf' :: Monad m => IndexedTraversal i a b c d   -> (i -> e -> c -> m e) -> e -> a -> e-ifoldlMOf :: Monad m => IndexedFolding i (Endo (e -> m e)) a b c d -> (i -> e -> c -> m e) -> e -> a -> m e-ifoldlMOf l f z0 xs = ifoldrOf l f' return xs z0-  where f' i x k z = f i z x >>= k-{-# INLINE ifoldlMOf #-}----------------------------------------------------------------------------------- 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---- | Traversal with an index.------ > itraverseOf = withIndex------ > itraverseOf :: IndexedTraversal i a b c d -> (i -> c -> f d) -> a -> f b-itraverseOf :: Overloaded (Index i) f a b c d -> (i -> c -> f d) -> a -> f b-itraverseOf = withIndex-{-# INLINE itraverseOf #-}---- |--- > iforOf = flip . itraverseOf-iforOf :: Overloaded (Index i) f a b c d -> a -> (i -> c -> f d) -> f b-iforOf = flip . withIndex-{-# INLINE iforOf #-}---- | 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.------ > imapMOf :: Monad m => IndexedTraversal a b c d -> (i -> c -> m d) -> a -> m b-imapMOf :: Overloaded (Index i) (WrappedMonad m) a b c d -> (i -> c -> m d) -> a -> m b-imapMOf l f = unwrapMonad . withIndex l (\i -> WrapMonad . f i)-{-# INLINE imapMOf #-}---- |--- > iforMOf = flip . imapMOf-iforMOf :: Overloaded (Index i) (WrappedMonad m) a b c d -> a -> (i -> c -> m d) -> m b-iforMOf = flip . imapMOf-{-# INLINE iforMOf #-}---- | Generalizes 'Data.Traversable.mapAccumR' to an arbitrary 'IndexedTraversal'.------ 'imapAccumROf' accumulates state from right to left.----imapAccumROf :: Overloaded (Index i) (Lazy.State s) a b c d -> (i -> s -> c -> (s, d)) -> s -> a -> (s, b)-imapAccumROf l f s0 a = swap (Lazy.runState (withIndex l (\i c -> State.state (\s -> swap (f i s c))) a) s0)-{-# INLINE imapAccumROf #-}---- | Generalized 'Data.Traversable.mapAccumL' to an arbitrary 'IndexedTraversal'.------ 'imapAccumLOf' accumulates state from left to right.-imapAccumLOf :: Overloaded (Index i) (Backwards (Lazy.State s)) a b c d -> (i -> s -> c -> (s, d)) -> s -> a -> (s, b)-imapAccumLOf l f s0 a = swap (Lazy.runState (forwards (withIndex l (\i c -> Backwards (State.state (\s -> swap (f i s c)))) a)) s0)-{-# INLINE imapAccumLOf #-}--swap :: (a,b) -> (b,a)-swap (a,b) = (b,a)-{-# INLINE swap #-}---- | Every 'IndexedSetter' 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------ > imapOf :: IndexedTraversal i a b c d -> (i -> c -> d) -> a -> b--- > imapOf :: IndexedSetter i a b c d -> (i -> c -> d) -> a -> b-imapOf :: Overloaded (Index i) Mutator a b c d -> (i -> c -> d) -> a -> b-imapOf l f = runMutator . withIndex l (\i -> Mutator . f i)-{-# INLINE imapOf #-}--infixr 4 %@---- | > (%@) = imapOf-(%@) :: Overloaded (Index i) Mutator a b c d -> (i -> c -> d) -> a -> b-l %@ f = runMutator . withIndex l (\i -> Mutator . f i)-{-# INLINE (%@) #-}+{-# SPECIALIZE icompose :: (k ~ l) => (i -> j -> k) -> Index i b c -> Index j a b -> Index l a c #-}
+ src/Control/Lens/IndexedFold.hs view
@@ -0,0 +1,311 @@+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Lens.IndexedFold+-- 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.IndexedFold+  (+  -- * Indexed Folds+    IndexedFold+  , ifoldMapOf+  , ifoldrOf+  , ifoldlOf+  , ianyOf+  , iallOf+  , itraverseOf_+  , iforOf_+  , imapMOf_+  , iforMOf_+  , iconcatMapOf+  , ifindOf+  , ifoldrOf'+  , ifoldlOf'+  , ifoldrMOf+  , ifoldlMOf+  , itoListOf+  ) where++import Control.Applicative+import Control.Lens.Getter+import Control.Lens.Indexed+import Control.Lens.IndexedGetter+import Control.Lens.Internal+import Control.Monad+import Data.Monoid++------------------------------------------------------------------------------+-- Indexed Folds+------------------------------------------------------------------------------++-- | Every 'IndexedFold' is a valid 'Control.Lens.Fold.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)++-- |+-- Fold an 'IndexedFold' or 'Control.Lens.IndexedTraversal.IndexedTraversal' by mapping indices and values to an arbitrary 'Monoid' with access+-- to the index @i@.+--+-- When you don't need access to the index then 'foldMapOf' is more flexible in what it accepts.+--+-- @'Control.Lens.Fold.foldMapOf' l = 'ifoldMapOf' l . 'const'@+--+-- > ifoldMapOf ::             IndexedGetter i a c        -> (i -> c -> m) -> a -> m+-- > ifoldMapOf :: Monoid m => IndexedFold i a c          -> (i -> c -> m) -> a -> m+-- > ifoldMapOf ::             IndexedLens i a b c d      -> (i -> c -> m) -> a -> m+-- > ifoldMapOf :: Monoid m => IndexedTraversal i a b c d -> (i -> c -> m) -> a -> m+ifoldMapOf :: IndexedGetting i m a b c d -> (i -> c -> m) -> a -> m+ifoldMapOf l f = runAccessor . withIndex l (\i -> Accessor . f i)+{-# INLINE ifoldMapOf #-}++-- |+-- Right-associative fold of parts of a structure that are viewed through an 'IndexedFold' or 'Control.Lens.IndexedTraversal.IndexedTraversal' with+-- access to the index @i@.+--+-- When you don't need access to the index then 'foldrOf' is more flexible in what it accepts.+--+-- @'Control.Lens.Fold.foldrOf' l = 'ifoldrOf' l . 'const'@+--+-- > ifoldrOf :: IndexedGetter i a c        -> (i -> c -> e -> e) -> e -> a -> e+-- > ifoldrOf :: IndexedFold i a c          -> (i -> c -> e -> e) -> e -> a -> e+-- > ifoldrOf :: IndexedLens i a b c d      -> (i -> c -> e -> e) -> e -> a -> e+-- > ifoldrOf :: IndexedTraversal i a b c d -> (i -> c -> e -> e) -> e -> a -> e+ifoldrOf :: IndexedGetting i (Endo e) a b c d -> (i -> c -> e -> e) -> e -> a -> e+ifoldrOf l f z t = appEndo (ifoldMapOf l (\i -> Endo . f i) t) z+{-# INLINE ifoldrOf #-}++-- |+-- Left-associative fold of the parts of a structure that are viewed through an 'IndexedFold' or 'Control.Lens.IndexedTraversal.IndexedTraversal' with+-- access to the index @i@.+--+-- When you don't need access to the index then 'foldlOf' is more flexible in what it accepts.+--+-- @'Control.Lens.Fold.foldlOf' l = 'ifoldlOf' l . 'const'@+--+-- > ifoldlOf :: IndexedGetter i a c        -> (i -> e -> c -> e) -> e -> a -> e+-- > ifoldlOf :: IndexedFold i a c          -> (i -> e -> c -> e) -> e -> a -> e+-- > ifoldlOf :: IndexedLens i a b c d      -> (i -> e -> c -> e) -> e -> a -> e+-- > ifoldlOf :: IndexedTraversal i a b c d -> (i -> e -> c -> e) -> e -> a -> e+ifoldlOf :: IndexedGetting i (Dual (Endo e)) a b c d -> (i -> e -> c -> e) -> e -> a -> e+ifoldlOf l f z t = appEndo (getDual (ifoldMapOf l (\i -> Dual . Endo . flip (f i)) t)) z+{-# INLINE ifoldlOf #-}++-- |+-- Return whether or not any element viewed through an 'IndexedFold' or 'Control.Lens.IndexedTraversal.IndexedTraversal' +-- satisfy a predicate, with access to the index @i@.+--+-- When you don't need access to the index then 'anyOf' is more flexible in what it accepts.+--+-- @'Control.Lens.Fold.anyOf' l = 'ianyOf' l . 'const'@+--+-- > ianyOf :: IndexedGetter i a c        -> (i -> c -> Bool) -> a -> Bool+-- > ianyOf :: IndexedFold i a c          -> (i -> c -> Bool) -> a -> Bool+-- > ianyOf :: IndexedLens i a b c d      -> (i -> c -> Bool) -> a -> Bool+-- > ianyOf :: IndexedTraversal i a b c d -> (i -> c -> Bool) -> a -> Bool+ianyOf :: IndexedGetting i Any a b c d -> (i -> c -> Bool) -> a -> Bool+ianyOf l f = getAny . ifoldMapOf l (\i -> Any . f i)+{-# INLINE ianyOf #-}++-- |+-- Return whether or not all elements viewed through an 'IndexedFold' or 'Control.Lens.IndexedTraversal.IndexedTraversal' +-- satisfy a predicate, with access to the index @i@.+--+-- When you don't need access to the index then 'allOf' is more flexible in what it accepts.+--+-- @'Control.Lens.Fold.allOf' l = 'iallOf' l . 'const'@+--+-- > iallOf :: IndexedGetter i a c        -> (i -> c -> Bool) -> a -> Bool+-- > iallOf :: IndexedFold i a c          -> (i -> c -> Bool) -> a -> Bool+-- > iallOf :: IndexedLens i a b c d      -> (i -> c -> Bool) -> a -> Bool+-- > iallOf :: IndexedTraversal i a b c d -> (i -> c -> Bool) -> a -> Bool+iallOf :: IndexedGetting i All a b c d -> (i -> c -> Bool) -> a -> Bool+iallOf l f = getAll . ifoldMapOf l (\i -> All . f i)+{-# INLINE iallOf #-}++-- |+-- Traverse the targets of an 'IndexedFold' or 'Control.Lens.IndexedTraversal.IndexedTraversal' with access to the index @i@, discarding the results.+--+-- When you don't need access to the index then 'traverseOf_' is more flexible in what it accepts.+--+-- @'Control.Lens.Fold.traverseOf_' l = 'itraverseOf' l . 'const'@+--+-- > itraverseOf_ :: Functor f     => IndexedGetter i a c        -> (i -> c -> f e) -> a -> f ()+-- > itraverseOf_ :: Applicative f => IndexedFold i a c          -> (i -> c -> f e) -> a -> f ()+-- > itraverseOf_ :: Functor f     => IndexedLens i a b c d      -> (i -> c -> f e) -> a -> f ()+-- > itraverseOf_ :: Applicative f => IndexedTraversal i a b c d -> (i -> c -> f e) -> a -> f ()+itraverseOf_ :: Functor f => IndexedGetting i (Traversed f) a b c d -> (i -> c -> f e) -> a -> f ()+itraverseOf_ l f = getTraversed . ifoldMapOf l (\i -> Traversed . void . f i)+{-# INLINE itraverseOf_ #-}++-- |+-- Traverse the targets of an 'IndexedFold' or 'Control.Lens.IndexedTraversal.IndexedTraversal' with access to the index, discarding the results+-- (with the arguments flipped).+--+-- @'iforOf_' = 'flip' . 'itraverseOf_'@+--+-- When you don't need access to the index then 'forOf_' is more flexible in what it accepts.+--+-- @'Control.Lens.Fold.forOf_' l a = 'iforOf' l a . 'const'@+--+-- > iforOf_ :: Functor f     => IndexedGetter i a c        -> a -> (i -> c -> f e) -> f ()+-- > iforOf_ :: Applicative f => IndexedFold i a c          -> a -> (i -> c -> f e) -> f ()+-- > iforOf_ :: Functor f     => IndexedLens i a b c d      -> a -> (i -> c -> f e) -> f ()+-- > iforOf_ :: Applicative f => IndexedTraversal i a b c d -> a -> (i -> c -> f e) -> f ()+iforOf_ :: Functor f => IndexedGetting i (Traversed f) a b c d -> a -> (i -> c -> f e) -> f ()+iforOf_ = flip . itraverseOf_+{-# INLINE iforOf_ #-}++-- |+-- Run monadic actions for each target of an 'IndexedFold' or 'Control.Lens.IndexedTraversal.IndexedTraversal' with access to the index,+-- discarding the results.+--+-- When you don't need access to the index then 'mapMOf_' is more flexible in what it accepts.+--+-- @'Control.Lens.Fold.mapMOf_' l = 'imapMOf' l . 'const'@+--+-- > imapMOf_ :: Monad m => IndexedGetter i a c        -> (i -> c -> m e) -> a -> m ()+-- > imapMOf_ :: Monad m => IndexedFold i a c          -> (i -> c -> m e) -> a -> m ()+-- > imapMOf_ :: Monad m => IndexedLens i a b c d      -> (i -> c -> m e) -> a -> m ()+-- > imapMOf_ :: Monad m => IndexedTraversal i a b c d -> (i -> c -> m e) -> a -> m ()+imapMOf_ :: Monad m => IndexedGetting i (Sequenced m) a b c d -> (i -> c -> m e) -> a -> m ()+imapMOf_ l f = getSequenced . ifoldMapOf l (\i -> Sequenced . liftM skip . f i)+{-# INLINE imapMOf_ #-}++skip :: a -> ()+skip _ = ()+{-# INLINE skip #-}++-- |+-- Run monadic actions for each target of an 'IndexedFold' or 'Control.Lens.IndexedTraversal.IndexedTraversal' with access to the index,+-- discarding the results (with the arguments flipped).+--+-- @'iforMOf_' = 'flip' . 'imapMOf_'@+--+-- When you don't need access to the index then 'forMOf_' is more flexible in what it accepts.+--+-- @'Control.Lens.Fold.forMOf_' l a = 'iforMOf' l a . 'const'@+--+-- > iforMOf_ :: Monad m => IndexedGetter i a c        -> a -> (i -> c -> m e) -> m ()+-- > iforMOf_ :: Monad m => IndexedFold i a c          -> a -> (i -> c -> m e) -> m ()+-- > iforMOf_ :: Monad m => IndexedLens i a b c d      -> a -> (i -> c -> m e) -> m ()+-- > iforMOf_ :: Monad m => IndexedTraversal i a b c d -> a -> (i -> c -> m e) -> m ()+iforMOf_ :: Monad m => IndexedGetting i (Sequenced m) a b c d -> a -> (i -> c -> m e) -> m ()+iforMOf_ = flip . imapMOf_+{-# INLINE iforMOf_ #-}++-- |+-- Concatenate the results of a function of the elements of an 'IndexedFold' or 'Control.Lens.IndexedTraversal.IndexedTraversal'+-- with access to the index.+--+-- When you don't need access to the index then 'concatMapOf_'  is more flexible in what it accepts.+--+-- @'Control.Lens.Fold.concatMapOf_' l = 'iconcatMapMOf' l . 'const'@+--+-- > iconcatMapOf :: IndexedGetter i a c        -> (i -> c -> [e]) -> a -> [e]+-- > iconcatMapOf :: IndexedFold i a c          -> (i -> c -> [e]) -> a -> [e]+-- > iconcatMapOf :: IndexedLens i a b c d      -> (i -> c -> [e]) -> a -> [e]+-- > iconcatMapOf :: IndexedTraversal i a b c d -> (i -> c -> [e]) -> a -> [e]+iconcatMapOf :: IndexedGetting i [e] a b c d -> (i -> c -> [e]) -> a -> [e]+iconcatMapOf l ices = runAccessor . withIndex l (\i -> Accessor . ices i)+{-# INLINE iconcatMapOf #-}++-- | The 'findOf' function takes an 'IndexedFold' or 'Control.Lens.IndexedTraversal.IndexedTraversal', a predicate that is also+-- supplied the index, a structure and returns the left-most element of the structure+-- matching the predicate, or 'Nothing' if there is no such element.+--+-- When you don't need access to the index then 'findOf' is more flexible in what it accepts.+--+-- @'Control.Lens.Fold.findOf' l = 'ifoldOf' l . 'const'@+--+-- > ifindOf :: IndexedGetter a c        -> (i -> c -> Bool) -> a -> Maybe (i, c)+-- > ifindOf :: IndexedFold a c          -> (i -> c -> Bool) -> a -> Maybe (i, c)+-- > ifindOf :: IndexedLens a b c d      -> (i -> c -> Bool) -> a -> Maybe (i, c)+-- > ifindOf :: IndexedTraversal a b c d -> (i -> c -> Bool) -> a -> Maybe (i, c)+ifindOf :: IndexedGetting i (First (i, c)) a b c d -> (i -> c -> Bool) -> a -> Maybe (i, c)+ifindOf l p = getFirst . ifoldMapOf l step where+  step i c+    | p i c     = First $ Just (i, c)+    | otherwise = First Nothing+{-# INLINE ifindOf #-}++-- | /Strictly/ fold right over the elements of a structure with an index.+--+-- When you don't need access to the index then 'foldrOf'' is more flexible in what it accepts.+--+-- @'Control.Lens.Fold.foldrOf'' l = 'ifoldrOf'' l . 'const'@+--+-- > ifoldrOf' :: IndexedGetter i a c        -> (i -> c -> e -> e) -> e -> a -> e+-- > ifoldrOf' :: IndexedFold i a c          -> (i -> c -> e -> e) -> e -> a -> e+-- > ifoldrOf' :: IndexedLens i a b c d      -> (i -> c -> e -> e) -> e -> a -> e+-- > ifoldrOf' :: IndexedTraversal i a b c d -> (i -> c -> e -> e) -> e -> a -> e+ifoldrOf' :: IndexedGetting i (Dual (Endo (e -> e))) a b c d -> (i -> c -> e -> e) -> e -> a -> e+ifoldrOf' l f z0 xs = ifoldlOf l f' id xs z0+  where f' i k x z = k $! f i x z+{-# INLINE ifoldrOf' #-}++-- | Fold over the elements of a structure with an index, associating to the left, but /strictly/.+--+-- When you don't need access to the index then 'foldlOf'' is more flexible in what it accepts.+--+-- @'Control.Lens.Fold.foldlOf'' l = 'ifoldlOf'' l . 'const'@+--+-- > ifoldlOf' :: IndexedGetter i a c          -> (i -> e -> c -> e) -> e -> a -> e+-- > ifoldlOf' :: IndexedFold i a c            -> (i -> e -> c -> e) -> e -> a -> e+-- > ifoldlOf' :: IndexedLens i a b c d        -> (i -> e -> c -> e) -> e -> a -> e+-- > ifoldlOf' :: IndexedTraversal i a b c d   -> (i -> e -> c -> e) -> e -> a -> e+ifoldlOf' :: IndexedGetting i (Endo (e -> e)) a b c d -> (i -> e -> c -> e) -> e -> a -> e+ifoldlOf' l f z0 xs = ifoldrOf l f' id xs z0+  where f' i x k z = k $! f i z x+{-# INLINE ifoldlOf' #-}++-- | Monadic fold right over the elements of a structure with an index.+--+-- When you don't need access to the index then 'foldrMOf' is more flexible in what it accepts.+--+-- @'Control.Lens.Fold.foldrMOf' l = 'ifoldrMOf' l . 'const'@+--+-- > ifoldrMOf :: Monad m => IndexedGetter i a c        -> (i -> c -> e -> m e) -> e -> a -> e+-- > ifoldrMOf :: Monad m => IndexedFold i a c          -> (i -> c -> e -> m e) -> e -> a -> e+-- > ifoldrMOf :: Monad m => IndexedLens i a b c d      -> (i -> c -> e -> m e) -> e -> a -> e+-- > ifoldrMOf :: Monad m => IndexedTraversal i a b c d -> (i -> c -> e -> m e) -> e -> a -> e+ifoldrMOf :: Monad m => IndexedGetting i (Dual (Endo (e -> m e))) a b c d -> (i -> c -> e -> m e) -> e -> a -> m e+ifoldrMOf l f z0 xs = ifoldlOf l f' return xs z0+  where f' i k x z = f i x z >>= k+{-# INLINE ifoldrMOf #-}++-- | Monadic fold over the elements of a structure with an index, associating to the left.+--+-- When you don't need access to the index then 'foldlMOf' is more flexible in what it accepts.+--+-- @'Control.Lens.Fold.foldlMOf' l = 'ifoldlMOf' l . 'const'@+--+-- > ifoldlOf' :: Monad m => IndexedGetter i a c          -> (i -> e -> c -> m e) -> e -> a -> e+-- > ifoldlOf' :: Monad m => IndexedFold i a c            -> (i -> e -> c -> m e) -> e -> a -> e+-- > ifoldlOf' :: Monad m => IndexedLens i a b c d        -> (i -> e -> c -> m e) -> e -> a -> e+-- > ifoldlOf' :: Monad m => IndexedTraversal i a b c d   -> (i -> e -> c -> m e) -> e -> a -> e+ifoldlMOf :: Monad m => IndexedGetting i (Endo (e -> m e)) a b c d -> (i -> e -> c -> m e) -> e -> a -> m e+ifoldlMOf l f z0 xs = ifoldrOf l f' return xs z0+  where f' i x k z = f i z x >>= k+{-# INLINE ifoldlMOf #-}++-- | Extract the key-value pairs from a structure.+--+-- When you don't need access to the indices, then 'toListOf' is more flexible in what it accepts.+--+-- @'Control.Lens.Fold.toListOf' l = 'map' 'fst' . 'itoListOf' l@+--+-- > itoListOf :: IndexedGetter i a c        -> a -> [(i,c)]+-- > itoListOf :: IndexedFold i a c          -> a -> [(i,c)]+-- > itoListOf :: IndexedLens i a b c d      -> a -> [(i,c)]+-- > itoListOf :: IndexedTraversal i a b c d -> a -> [(i,c)]+itoListOf :: IndexedGetting i [(i,c)] a b c d -> a -> [(i,c)]+itoListOf l = ifoldMapOf l (\i c -> [(i,c)])+{-# INLINE itoListOf #-}
+ src/Control/Lens/IndexedGetter.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE MultiParamTypeClasses #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Lens.IndexedGetter+-- Copyright   :  (C) 2012 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  rank 2 types, MPTCs+--+----------------------------------------------------------------------------+module Control.Lens.IndexedGetter+  (+  -- * Indexed Folds+    IndexedGetter+  , IndexedGetting+  ) where++import Control.Lens.Getter+import Control.Lens.Indexed++------------------------------------------------------------------------------+-- Indexed Getters+------------------------------------------------------------------------------++-- | Every 'IndexedGetter' is a valid 'Control.Lens.IndexedFold.IndexedFold' and 'Getter'.+type IndexedGetter i a c = forall k f b d. (Indexed i k, Gettable f) => k (c -> f d) (a -> f b)++-- | Used to consume an 'Control.Lens.IndexedFold.IndexedFold'.+type IndexedGetting i m a b c d = Index i (c -> Accessor m d) (a -> Accessor m b)
+ src/Control/Lens/IndexedLens.hs view
@@ -0,0 +1,103 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}++#ifndef MIN_VERSION_mtl+#define MIN_VERSION_mtl(x,y,z) 1+#endif++-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Lens.IndexedLens+-- 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.IndexedLens+  (+  -- * Indexed Lenses+    IndexedLens+  , (%%@~)+  , (<%@~)+  , (%%@=)+  , (<%@=)++  -- * Simple+  , SimpleIndexedLens+  ) where++import Control.Lens.Indexed+import Control.Lens.Type+import Control.Monad.State.Class as State++infixr 4 %%@~, <%@~+infix  4 %%@=, <%@=++-- | Every 'IndexedLens' is a valid 'Lens' and a valid 'Control.Lens.IndexedTraversal.IndexedTraversal'.+type IndexedLens i a b c d = forall f k. (Indexed i k, Functor f) => k (c -> f d) (a -> f b)++-- | @type 'SimpleIndexedLens' i = 'Simple' ('IndexedLens' i)@+type SimpleIndexedLens i a b = IndexedLens i a a b b++-- | Adjust the target of an 'IndexedLens' returning the intermediate result, or+-- adjust all of the targets of an 'Control.Lens.IndexedTraversal.IndexedTraversal' and return a monoidal summary+-- along with the answer.+--+-- @l '<%~' f = l '<%@~' 'const' f@+--+-- When you do not need access to the index then ('<%~') is more liberal in what it can accept.+--+-- If you do not need the intermediate result, you can use ('Control.Lens.Type.%@~') or even ('Control.Lens.Type.%~').+--+-- > (<%@~) ::             IndexedLens i a b c d -> (i -> c -> d) -> a -> (d, b)+-- > (<%@~) :: Monoid d => IndexedTraversal i a b c d -> (i -> c -> d) -> a -> (d, b)+(<%@~) :: Overloaded (Index i) ((,)d) a b c d -> (i -> c -> d) -> a -> (d, b)+l <%@~ f = withIndex l $ \i c -> let d = f i c in (d, d)+{-# INLINE (<%@~) #-}++-- | Adjust the target of an 'IndexedLens' returning a supplementary result, or+-- adjust all of the targets of an 'Control.Lens.IndexedTraversal.IndexedTraversal' and return a monoidal summary+-- of the supplementary results and the answer.+--+-- @('%%@~') = 'withIndex'@+--+-- > (%%@~) ::             IndexedLens i a b c d      -> (i -> c -> (e, d)) -> a -> (e, b)+-- > (%%@~) :: Monoid e => IndexedTraversal i a b c d -> (i -> c -> (e, d)) -> a -> (e, b)+(%%@~) :: Overloaded (Index i) ((,)e) a b c d -> (i -> c -> (e, d)) -> a -> (e, b)+(%%@~) = withIndex+{-# INLINE (%%@~) #-}++-- | Adjust the target of an 'IndexedLens' returning a supplementary result, or+-- adjust all of the targets of an 'Control.Lens.IndexedTraversal.IndexedTraversal' within the current state, and+-- return a monoidal summary of the supplementary results.+--+-- @l '%%@=' f = 'state' (l '%%@~' f)@+--+-- > (%%@=) :: MonadState a m                IndexedLens i a a c d      -> (i -> c -> (e, d)) -> a -> m e+-- > (%%@=) :: (MonadState a m, Monoid e) => IndexedTraversal i a a c d -> (i -> c -> (e, d)) -> a -> m e+(%%@=) :: MonadState a m => Overloaded (Index i) ((,)e) a a c d -> (i -> c -> (e, d)) -> m e+#if MIN_VERSION_mtl(2,1,0)+l %%@= f = State.state (l %%@~ f)+#else+l %%@= f = do+  (e, d) <- State.gets (l %%@~ f)+  State.put d+  return e+#endif+{-# INLINE (%%@=) #-}++-- | Adjust the target of an 'IndexedLens' returning the intermediate result, or+-- adjust all of the targets of an 'Control.Lens.IndexedTraversal.IndexedTraversal' within the current state, and+-- return a monoidal summary of the intermediate results.+--+-- > (<%@=) :: MonadState a m                IndexedLens i a a c d      -> (i -> c -> d) -> a -> m d+-- > (<%@=) :: (MonadState a m, Monoid e) => IndexedTraversal i a a c d -> (i -> c -> d) -> a -> m d+(<%@=) :: MonadState a m => Overloaded (Index i) ((,)d) a a c d -> (i -> c -> d) -> m d+l <%@= f = l %%@= \ i c -> let d = f i c in (d, d)+{-# INLINE (<%@=) #-}
+ src/Control/Lens/IndexedSetter.hs view
@@ -0,0 +1,84 @@+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Lens.IndexedSetter+-- 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.IndexedSetter+  (+  -- * Indexed Setter+    IndexedSetter+  , imapOf+  , (%@~)+  , (%@=)+  -- * Simple+  , SimpleIndexedSetter+  ) where++import Control.Lens.Indexed+import Control.Lens.Setter+import Control.Lens.Type+import Control.Monad.State.Class as State++infixr 4 %@~+infix  4 %@=++-- | Every 'IndexedSetter' 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 'SimpleIndexedSetter i = 'Simple' ('IndexedSetter' i)@+type SimpleIndexedSetter i a b = IndexedSetter i a a b b++-- | Map with index.+--+-- When you do not need access to the index, then 'mapOf' is more liberal in what it can accept.+--+-- @'mapOf' l = 'imapOf' l . 'const'@+--+-- > imapOf :: IndexedSetter i a b c d    -> (i -> c -> d) -> a -> b+-- > imapOf :: IndexedLens i a b c d      -> (i -> c -> d) -> a -> b+-- > imapOf :: IndexedTraversal i a b c d -> (i -> c -> d) -> a -> b+imapOf :: Overloaded (Index i) Mutator a b c d -> (i -> c -> d) -> a -> b+imapOf l f = runMutator . withIndex l (\i -> Mutator . f i)+{-# INLINE imapOf #-}++-- | Adjust every target of an 'IndexedSetter', 'Control.Lens.IndexedLens.IndexedLens' or 'Control.Lens.IndexedTraversal.IndexedTraversal'+-- with access to the index.+--+-- @('%@~') = 'imapOf'@+--+-- When you do not need access to the index then ('%@~') is more liberal in what it can accept.+--+-- @l '%~' f = l '%@~' 'const' f@+--+-- > (%@~) :: IndexedSetter i a b c d    -> (i -> c -> d) -> a -> b+-- > (%@~) :: IndexedLens i a b c d      -> (i -> c -> d) -> a -> b+-- > (%@~) :: IndexedTraversal i a b c d -> (i -> c -> d) -> a -> b+(%@~) :: Overloaded (Index i) Mutator a b c d -> (i -> c -> d) -> a -> b+l %@~ f = runMutator . withIndex l (\i -> Mutator . f i)+{-# INLINE (%@~) #-}++-- | Adjust every target in the current state of an 'IndexedSetter', 'Control.Lens.IndexedLens.IndexedLens' or 'Control.Lens.IndexedTraversal.IndexedTraversal'+-- with access to the index.+--+-- When you do not need access to the index then ('%=') is more liberal in what it can accept.+--+-- @l '%=' f = l '%@=' 'const' f@+--+-- > (%@=) :: MonadState a m => IndexedSetter i a a c d    -> (i -> c -> d) -> m ()+-- > (%@=) :: MonadState a m => IndexedLens i a a c d      -> (i -> c -> d) -> m ()+-- > (%@=) :: MonadState a m => IndexedTraversal i a b c d -> (i -> c -> d) -> m ()+(%@=) :: MonadState a m => Overloaded (Index i) Mutator a a c d -> (i -> c -> d) -> m ()+l %@= f = State.modify (l %@~ f)+{-# INLINE (%@=) #-}
+ src/Control/Lens/IndexedTraversal.hs view
@@ -0,0 +1,134 @@+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Lens.IndexedTraversal+-- 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.IndexedTraversal+  (+  -- * Indexed Traversals+    IndexedTraversal+  , itraverseOf+  , iforOf+  , imapMOf+  , iforMOf+  , imapAccumROf+  , imapAccumLOf++  -- * Simple+  , SimpleIndexedTraversal+  ) where++import Control.Applicative+import Control.Applicative.Backwards+import Control.Lens.Indexed+import Control.Lens.Type+import Control.Monad.Trans.State.Lazy as Lazy++------------------------------------------------------------------------------+-- Indexed Traversals+------------------------------------------------------------------------------++-- | Every indexed traversal is a valid 'Control.Lens.Traversal.Traversal' or 'Control.Lens.IndexedFold.IndexedFold'.+--+-- The 'Indexed' constraint is used to allow an 'IndexedTraversal' to be used directly as a 'Control.Lens.Traversal.Traversal'.+--+-- The 'Control.Lens.Traversal.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 'SimpleIndexedTraversal' i = 'Simple' ('IndexedTraversal' i)@+type SimpleIndexedTraversal i a b = IndexedTraversal i a a b b++-- | Traversal with an index.+--+-- NB: When you don't need access to the index then you can just apply your 'IndexedTraversal'+-- directly as a function!+--+-- @'itraverseOf' = 'withIndex'@+--+-- @'Control.Lens.Traversal.traverseOf' = 'itraverseOf' . 'const' = 'id'@+--+-- > itraverseOf :: IndexedLens i a b c d      -> (i -> c -> f d) -> a -> f b+-- > itraverseOf :: IndexedTraversal i a b c d -> (i -> c -> f d) -> a -> f b+itraverseOf :: Overloaded (Index i) f a b c d -> (i -> c -> f d) -> a -> f b+itraverseOf = withIndex+{-# INLINE itraverseOf #-}++-- |+-- Traverse with an index (and the arguments flipped)+--+-- @'Control.Lens.Traversal.forOf' l a = 'iforOf' l a . 'const'@+--+-- @'iforOf' = 'flip' . 'itraverseOf'@+--+-- > iforOf :: IndexedLens i a b c d      -> a -> (i -> c -> f d) -> f b+-- > iforOf :: IndexedTraversal i a b c d -> a -> (i -> c -> f d) -> f b+iforOf :: Overloaded (Index i) f a b c d -> a -> (i -> c -> f d) -> f b+iforOf = flip . withIndex+{-# INLINE iforOf #-}++-- | 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.+--+-- When you don't need access to the index 'mapMOf' is more liberal in what it can accept.+--+-- @'Control.Lens.Traversal.mapMOf' = 'imapMOf' . 'const'@+--+-- > imapMOf :: Monad m => IndexedLens      i a b c d -> (i -> c -> m d) -> a -> m b+-- > imapMOf :: Monad m => IndexedTraversal i a b c d -> (i -> c -> m d) -> a -> m b+imapMOf :: Overloaded (Index i) (WrappedMonad m) a b c d -> (i -> c -> m d) -> a -> m b+imapMOf l f = unwrapMonad . withIndex l (\i -> WrapMonad . f i)+{-# INLINE imapMOf #-}++-- | 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 (and the arguments flipped).+--+-- @'Control.Lens.Traversal.forMOf' l a = 'iforMOf' l a . 'const'@+--+-- @'iforMOf' = 'flip' . 'imapMOf'@+--+-- > iforMOf :: Monad m => IndexedLens i a b c d      -> a -> (i -> c -> m d) -> m b+-- > iforMOf :: Monad m => IndexedTraversal i a b c d -> a -> (i -> c -> m d) -> m b+iforMOf :: Overloaded (Index i) (WrappedMonad m) a b c d -> a -> (i -> c -> m d) -> m b+iforMOf = flip . imapMOf+{-# INLINE iforMOf #-}++-- | Generalizes 'Data.Traversable.mapAccumR' to an arbitrary 'IndexedTraversal' with access to the index.+--+-- 'imapAccumROf' accumulates state from right to left.+--+-- @'Control.Lens.Traversal.mapAccumROf' l = 'imapAccumROf' l . 'const'@+--+-- > imapAccumROf :: IndexedLens i a b c d      -> (i -> s -> c -> (s, d)) -> s -> a -> (s, b)+-- > imapAccumROf :: IndexedTraversal i a b c d -> (i -> s -> c -> (s, d)) -> s -> a -> (s, b)+imapAccumROf :: Overloaded (Index i) (Lazy.State s) a b c d -> (i -> s -> c -> (s, d)) -> s -> a -> (s, b)+imapAccumROf l f s0 a = swap (Lazy.runState (withIndex l (\i c -> Lazy.state (\s -> swap (f i s c))) a) s0)+{-# INLINE imapAccumROf #-}++-- | Generalizes 'Data.Traversable.mapAccumL' to an arbitrary 'IndexedTraversal' with access to the index.+--+-- 'imapAccumLOf' accumulates state from left to right.+--+-- @'Control.Lens.Traversal.mapAccumLOf' l = 'imapAccumLOf' l . 'const'@+--+-- > imapAccumLOf :: IndexedLens i a b c d      -> (i -> s -> c -> (s, d)) -> s -> a -> (s, b)+-- > imapAccumLOf :: IndexedTraversal i a b c d -> (i -> s -> c -> (s, d)) -> s -> a -> (s, b)+imapAccumLOf :: Overloaded (Index i) (Backwards (Lazy.State s)) a b c d -> (i -> s -> c -> (s, d)) -> s -> a -> (s, b)+imapAccumLOf l f s0 a = swap (Lazy.runState (forwards (withIndex l (\i c -> Backwards (Lazy.state (\s -> swap (f i s c)))) a)) s0)+{-# INLINE imapAccumLOf #-}++swap :: (a,b) -> (b,a)+swap (a,b) = (b,a)+{-# INLINE swap #-}+
src/Control/Lens/Internal.hs view
@@ -31,6 +31,7 @@  import Control.Applicative import Control.Category+import Control.Monad import Prelude hiding ((.),id) import Data.Monoid @@ -38,7 +39,7 @@ -- Functors ----------------------------------------------------------------------------- --- | Used by 'Focus'+-- | Used by 'Control.Lens.Type.Focus'  newtype Focusing m c a = Focusing { unfocusing :: m (c, a) } @@ -54,16 +55,16 @@     (d, a) <- ma     return (mappend c d, f a) --- | The indexed store can be used to characterize a 'LensFamily'--- and is used by 'clone'+-- | The indexed store can be used to characterize a 'Control.Lens.Type.Lens'+-- and is used by 'Control.Lens.Type.clone'  data IndexedStore c d a = IndexedStore (d -> a) c  instance Functor (IndexedStore c d) where   fmap f (IndexedStore g c) = IndexedStore (f . g) c --- | Applicative composition of @State Int@ with a 'Functor', used--- by 'elementOf', 'elementsOf', 'traverseElement', 'traverseElementsOf'+-- | Applicative composition of @'Control.Monad.Trans.State.Lazy.State' 'Int'@ with a 'Functor', used+-- by 'Control.Lens.Traversal.elementOf', 'Control.Lens.Traversal.elementsOf', 'Control.Lens.Traversal.traverseElement', 'Control.Lens.Traversal.traverseElementsOf'  newtype AppliedState f a = AppliedState { runAppliedState :: Int -> (f a, Int) } @@ -77,7 +78,7 @@     (ff, j) -> case ma j of        (fa, k) -> (ff <*> fa, k) --- | Used internally by 'traverseOf_', 'mapM_' and the like.+-- | Used internally by 'Control.Lens.Traversal.traverseOf_' and the like.  newtype Traversed f = Traversed { getTraversed :: f () } @@ -85,14 +86,14 @@   mempty = Traversed (pure ())   Traversed ma `mappend` Traversed mb = Traversed (ma *> mb) --- | Used internally by 'mapM_' and the like.+-- | Used internally by 'Control.Lens.Traversal.mapM_' and the like. newtype Sequenced m = Sequenced { getSequenced :: m () }  instance Monad m => Monoid (Sequenced m) where   mempty = Sequenced (return ())   Sequenced ma `mappend` Sequenced mb = Sequenced (ma >> mb) --- | Used for 'minimumOf'+-- | Used for 'Control.Lens.Fold.minimumOf' data Min a = NoMin | Min a  instance Ord a => Monoid (Min a) where@@ -101,12 +102,12 @@   mappend m NoMin = m   mappend (Min a) (Min b) = Min (min a b) --- | Obtain the minimum+-- | Obtain the minimum. getMin :: Min a -> Maybe a getMin NoMin   = Nothing getMin (Min a) = Just a --- | Used for 'maximumOf'+-- | Used for 'Control.Lens.Fold.maximumOf' data Max a = NoMax | Max a  instance Ord a => Monoid (Max a) where@@ -120,7 +121,7 @@ getMax NoMax   = Nothing getMax (Max a) = Just a --- | The result of trying to find the nth element of a 'Traversal'.+-- | The result of trying to find the /n/th 'Control.Lens.Traversal.element' of a 'Control.Lens.Traversal.Traversal'. data ElementOfResult f a   = Searching {-# UNPACK #-} !Int a   | Found {-# UNPACK #-} !Int (f a)@@ -131,8 +132,8 @@   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 }+-- | Used to find the /n/th 'Control.Lens.Traversal.element' of a 'Control.Lens.Traversal.Traversal'.+newtype ElementOf f a = ElementOf { getElementOf :: Int -> ElementOfResult f a }  instance Functor f => Functor (ElementOf f) where   fmap f (ElementOf m) = ElementOf $ \i -> case m i of
src/Control/Lens/Iso.hs view
@@ -146,18 +146,20 @@  -- | This isomorphism can be used to wrap or unwrap a value in 'Identity'. ----- @x^.identity = 'Identity' x@------ @'Identity' x^.from identity = x@+-- @+-- 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@+-- @+-- 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
@@ -10,7 +10,7 @@ -- -- Corepresentable endofunctors represented by their polymorphic lenses ----- The polymorphic lenses of the form @(forall x. Lens (f x) x)@ each+-- The polymorphic lenses of the form @(forall x. 'Lens' (f x) x)@ each -- represent a distinct path into a functor @f@. If the functor is entirely -- characterized by assigning values to these paths, then the functor is -- representable.@@ -22,23 +22,31 @@ -- -- > data Pair a = Pair { _x :: a, _y :: a } ----- > makeLenses ''Pair+-- @ 'Control.Lens.TH.makeLenses' \'\'Pair@ ----- > instance Representable Pair where--- >   rep f = Pair (f x) (f y)+-- @+-- instance 'Representable' Pair where+--   'rep' f = Pair (f x) (f y)+-- @ -- -- From there, you can get definitions for a number of instances for free. ----- > instance Applicative Pair where--- >   pure  = pureRep--- >   (<*>) = apRep+-- @+-- instance 'Applicative' Pair where+--   'pure'  = 'pureRep'+--   ('<*>') = 'apRep'+-- @ ----- > instance Monad Pair where--- >   return = pureRep--- >   (>>=) = bindRep+-- @+-- instance 'Monad' Pair where+--   'return' = 'pureRep'+--   ('>>=') = 'bindRep'+-- @ ----- > instance Distributive Pair where--- >   distribute = distributeRep+-- @+-- instance 'Data.Distributive.Distributive' Pair where+--   'Data.Distributive.distribute' = 'distributeRep'+-- @ -- ---------------------------------------------------------------------------- module Control.Lens.Representable@@ -84,9 +92,9 @@ -- | Representable Functors. -- -- A 'Functor' @f@ is 'Representable' if it is isomorphic to @(x -> a)@--- for some x. All such functors can be represented by choosing @x@ to be+-- for some x. Nearly all such functors can be represented by choosing @x@ to be -- the set of lenses that are polymorphic in the contents of the 'Functor',--- that is to say @x = Rep f@ is a valid choice of 'x' for every +-- that is to say @x = 'Rep' f@ is a valid choice of 'x' for (nearly) every -- 'Representable' 'Functor'. -- -- Note: Some sources refer to covariant representable functors as@@ -104,53 +112,60 @@ instance Representable Identity where   rep f = Identity (f (from identity)) --- | NB: The Eq requirement on this instance is a consequence of a lens--- rather than 'e' as the representation.+-- | NB: The 'Eq' requirement on this instance is a consequence of the choice of 'Lens' as a 'Rep', it isn't fundamental. instance Eq e => Representable ((->) e) where   rep f e = f (resultAt e) --- | 'fmapRep' is a valid default definition for 'fmap' for a representable+-- | 'fmapRep' is a valid default definition for 'fmap' for a 'Representable' -- functor. ----- > fmapRep f m = rep $ \i -> f (m^.i)+-- @'fmapRep' f m = 'rep' '$' \i -> f (m '^.' i)@ ----- Usage for a representable functor @Foo@:+-- Usage for a @'Representable' Foo@: ----- > instance Functor Foo where--- >   fmap = fmapRep+-- @+-- instance 'Functor' Foo where+--   'fmap' = 'fmapRep'+-- @  fmapRep :: Representable f => (a -> b) -> f a -> f b fmapRep f m = rep $ \i -> f (m^.i) {-# INLINE fmapRep #-}  -- | 'pureRep' is a valid default definition for 'pure' and 'return' for a--- representable functor.+-- 'Representable' functor. ----- > pureRep = rep . const+-- @'pureRep' = 'rep' . 'const'@ ----- Usage for a representable functor @Foo@:+-- Usage for a @'Representable' Foo@: ----- > instance Applicative Foo where--- >    pure = pureRep--- >    (<*>) = apRep+-- @+-- instance 'Applicative' Foo where+--   'pure' = 'pureRep'+--   ...+-- @ ----- > instance Monad Foo where--- >   return = pureRep--- >   (>>=) = bindRep+-- @+-- instance 'Monad' Foo where+--   'return' = 'pureRep'+--   ...+-- @ pureRep :: Representable f => a -> f a pureRep = rep . const {-# INLINE pureRep #-} --- | 'apRep' is a valid default definition for '(<*>)' for a representable+-- | 'apRep' is a valid default definition for ('<*>') for a 'Representable' -- functor. ----- > apRep mf ma = rep $ \i -> mf^.i $ ma^.i+-- @'apRep' mf ma = 'rep' '$' \i -> mf '^.' i '$' ma '^.' i@ ----- Usage for a representable functor @Foo@:+-- Usage for a @'Representable' Foo@: ----- > instance Applicative Foo where--- >    pure = pureRep--- >   (<*>) = apRep+-- @+-- instance 'Applicative' Foo where+--   'pure' = 'pureRep'+--   ('<*>') = 'apRep'+-- @ apRep :: Representable f => f (a -> b) -> f a -> f b apRep mf ma = rep $ \i -> mf^.i $ ma^.i {-# INLINE apRep #-}@@ -158,25 +173,29 @@ -- | 'bindRep' is a valid default default definition for '(>>=)' for a -- representable functor. ----- > bindRep m f = rep $ \i -> f(m^.i)^.i+-- @'bindRep' m f = 'rep' '$' \i -> f (m '^.' i) '^.' i@ ----- Usage for a representable functor @Foo@:+-- Usage for a @'Representable' Foo@: ----- > instance Monad ... where--- >   return = pureRep--- >   (>>=) = bindRep+-- @+-- instance 'Monad' Foo where+--   'return' = 'pureRep'+--   ('>>=') = 'bindRep'+-- @ bindRep :: Representable f => f a -> (a -> f b) -> f b bindRep m f = rep $ \i -> f(m^.i)^.i {-# INLINE bindRep #-}  -- | A default definition for 'Data.Distributive.distribute' for a 'Representable' 'Functor' ----- > distributeRep wf = rep $ \i -> fmap (^.i) wf+-- @'distributeRep' wf = 'rep' '$' \i -> 'fmap' ('^.' i) wf@ ----- Typical Usage:+-- Usage for a @'Representable' Foo@: ----- > instance Distributive ... where--- >   distribute = distributeRep+-- @+-- instance 'Data.Distributive.Distributive' Foo where+--   'Data.Distributive.distribute' = 'distributeRep'+-- @ distributeRep :: (Representable f, Functor w) => w (f a) -> f (w a) distributeRep wf = rep $ \i -> fmap (^.i) wf {-# INLINE distributeRep #-}@@ -186,9 +205,9 @@ -----------------------------------------------------------------------------  -- | Sometimes you need to store a path lens into a container, but at least--- at this time, impredicative polymorphism in GHC is somewhat lacking.+-- at this time, @ImpredicativePolymorphism@ in GHC is somewhat lacking. ----- This type provides a way to, say, store a list of polymorphic lenses.+-- This type provides a way to, say, store a @[]@ of polymorphic lenses. newtype Path f = Path { walk :: Rep f }  -- | A 'Representable' 'Functor' has a fixed shape. This fills each position@@ -208,64 +227,64 @@ -----------------------------------------------------------------------------  --- | Map over a 'Representable' 'Functor' with access to the lens for the +-- | Map over a 'Representable' functor with access to the 'Lens' for the -- current position ----- > mapWithKey f m = rep $ \i -> f i (m^.i)+-- @'mapWithRep' f m = 'rep' '$' \i -> f i (m '^.' i)@ mapWithRep :: Representable f => (Rep f -> a -> b) -> f a -> f b mapWithRep f m = rep $ \i -> f i (m^.i) {-# INLINE mapWithRep #-} --- | Traverse a 'Representable' 'Functor' with access to the current path+-- | Traverse a 'Representable' functor with access to the current path traverseWithRep :: (Representable f, Traversable f, Applicative g)                 => (Rep f -> a -> g b) -> f a -> g (f b) traverseWithRep f m = sequenceA (mapWithRep f m) {-# INLINE traverseWithRep #-} --- | Traverse a 'Representable' 'Functor' with access to the current path--- as a lens, discarding the result+-- | Traverse a 'Representable' functor with access to the current path+-- as a 'Lens', discarding the result traverseWithRep_ :: (Representable f, Foldable f, Applicative g)                  => (Rep f -> a -> g b) -> f a -> g () traverseWithRep_ f m = sequenceA_ (mapWithRep f m) {-# INLINE traverseWithRep_ #-} --- | Traverse a 'Representable' 'Functor' with access to the current path--- and a lens (and the arguments flipped)+-- | Traverse a 'Representable' functor with access to the current path+-- and a 'Lens' (and the arguments flipped) forWithRep :: (Representable f, Traversable f, Applicative g)                 => f a -> (Rep f -> a -> g b) -> g (f b) forWithRep m f = sequenceA (mapWithRep f m) {-# INLINE forWithRep #-} --- | 'mapM' over a 'Representable' 'Functor' with access to the current path--- as a lens+-- | 'mapM' over a 'Representable' functor with access to the current path+-- as a 'Lens' mapMWithRep :: (Representable f, Traversable f, Monad m)                 => (Rep f -> a -> m b) -> f a -> m (f b) mapMWithRep f m = Traversable.sequence (mapWithRep f m) {-# INLINE mapMWithRep #-} --- | 'mapM' over a 'Representable' 'Functor' with access to the current path--- as a lens, discarding the result+-- | 'mapM' over a 'Representable' functor with access to the current path+-- as a 'Lens', discarding the result mapMWithRep_ :: (Representable f, Foldable f, Monad m)                  => (Rep f -> a -> m b) -> f a -> m () mapMWithRep_ f m = Foldable.sequence_ (mapWithRep f m) {-# INLINE mapMWithRep_ #-} --- | 'mapM' over a 'Representable' 'Functor' with access to the current path--- as a lens (with the arguments flipped)+-- | 'mapM' over a 'Representable' functor with access to the current path+-- as a 'Lens' (with the arguments flipped) forMWithRep :: (Representable f, Traversable f, Monad m)                 => f a -> (Rep f -> a -> m b) -> m (f b) forMWithRep m f = Traversable.sequence (mapWithRep f m) {-# INLINE forMWithRep #-} --- | Fold over a 'Representable' 'Functor' with access to the current path--- as a lens, yielding a 'Monoid'+-- | Fold over a 'Representable' functor with access to the current path+-- as a 'Lens', yielding a 'Monoid' foldMapWithRep :: (Representable f, Foldable f, Monoid m)                => (Rep f -> a -> m) -> f a -> m foldMapWithRep f m = fold (mapWithRep f m) {-# INLINE foldMapWithRep #-} --- | Fold over a 'Representable' 'Functor' with access to the current path--- as a lens.+-- | Fold over a 'Representable' functor with access to the current path+-- as a 'Lens'. foldrWithRep :: (Representable f, Foldable f) => (Rep f -> a -> b -> b) -> b -> f a -> b foldrWithRep f b m = Foldable.foldr id b (mapWithRep f m) {-# INLINE foldrWithRep #-}
src/Control/Lens/Setter.hs view
@@ -1,6 +1,5 @@ {-# LANGUAGE Rank2Types #-} {-# LANGUAGE LiberalTypeSynonyms #-}-{-# OPTIONS_GHC -fno-warn-unused-binds #-} ----------------------------------------------------------------------------- -- | -- Module      :  Control.Lens.Setter@@ -11,13 +10,13 @@ -- 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+-- 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+-- @type 'Setter' a b c d = (c -> 'Identity' d) -> a -> 'Identity' b@ -----  Every 'Control.Lens.Traversal.Traversal' is a valid 'Setter', since 'Identity' is 'Applicative'.+-- Every 'Control.Lens.Traversal.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 ('<$').@@ -75,17 +74,19 @@ -- -- You can't 'view' a 'Setter' in general, so the other two laws are irrelevant. ----- However, two functor laws apply to a 'Setter'+-- However, two functor laws apply to a 'Setter': ----- > adjust l id = id--- > adjust l f . adjust l g = adjust l (f . g)+-- 1. @'adjust' l id = id@ --+-- 2. @'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)+-- 1. @l 'pure' = 'pure'@ ----- You can compose a 'Setter' with a 'Control.Lens.Type.Lens' or a 'Control.Lens.Traversal.Traversal' using @(.)@ from the Prelude+-- 2. @l f . 'run' . l g = l (f . 'run' . g)@+--+-- You can compose a 'Setter' with a 'Control.Lens.Type.Lens' or a 'Control.Lens.Traversal.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 @@ -140,9 +141,11 @@  -- | This setter can be used to map over all of the values in a 'Functor'. ----- > fmap        = adjust mapped--- > fmapDefault = adjust traverse--- > (<$)        = set mapped+-- @'fmap'        = 'adjust' 'mapped'@+--+-- @'Data.Traversable.fmapDefault' = 'adjust' 'Data.Traversable.traverse'@+--+-- @('<$')        = 'set' 'mapped'@ mapped :: Functor f => Setter (f a) (f b) a b mapped = sets fmap {-# INLINE mapped #-}@@ -151,15 +154,16 @@ -- -- Your supplied function @f@ is required to satisfy: ----- > f id = id--- > f g . f h = f (g . h)+-- @f 'id' = 'id'@+-- @f g '.' f h = f (g '.' h)@ -- -- Equational reasoning: ----- > sets . adjust = id--- > adjust . sets = id+-- @'sets' . 'adjust' = 'id'@ ----- Another way to view 'sets' is that it takes a 'semantic editor combinator'+-- @'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)@@ -172,16 +176,20 @@ -- | Modify the target of a 'Control.Lens.Type.Lens' or all the targets of a 'Setter' or 'Control.Lens.Traversal.Traversal' -- with a function. ----- > fmap        = adjust mapped--- > fmapDefault = adjust traverse+-- @'fmap'        = 'adjust' 'mapped'@ ----- > sets . adjust = id--- > adjust . sets = id+-- @'Data.Traversable.fmapDefault' = 'adjust' 'Data.Traversable.traverse'@ ----- > adjust :: Setter a b c d -> (c -> d) -> a -> b+-- Free Theorems: --+-- 1. @'sets' . 'adjust' = 'id'@+--+-- 2. @'adjust' . 'sets' = 'id'@+-- -- Another way to view 'adjust' is to say that it transformers a 'Setter' into a -- \"semantic editor combinator\".+--+-- @'adjust' :: 'Setter' a b c d -> (c -> d) -> a -> b@ adjust :: Setting a b c d -> (c -> d) -> a -> b adjust l f = runMutator . l (Mutator . f) {-# INLINE adjust #-}@@ -189,14 +197,18 @@ -- | Modify the target of a 'Control.Lens.Type.Lens' or all the targets of a 'Setter' or 'Control.Lens.Traversal.Traversal' -- with a function. This is an alias for adjust that is provided for consistency. ----- > mapOf = adjust+-- @'mapOf'       = 'adjust'@ ----- > fmap        = mapOf mapped--- > fmapDefault = mapOf traverse+-- @'fmap'        = 'mapOf' 'mapped'@ ----- > sets . mapOf = id--- > mapOf . sets = id+-- @'fmapDefault' = 'mapOf' 'traverse'@ --+-- Free Theorems:+--+-- 1. @'sets' . 'mapOf' = 'id'@+--+-- 2. @'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@@ -208,7 +220,7 @@ -- | Replace the target of a 'Control.Lens.Type.Lens' or all of the targets of a 'Setter' -- or 'Control.Lens.Traversal.Traversal' with a constant value. ----- > (<$) = set mapped+-- @('<$') = 'set' 'mapped'@ -- -- > set :: Setter a b c d    -> d -> a -> b -- > set :: Iso a b c d       -> d -> a -> b@@ -223,12 +235,14 @@ -- -- This is an infix version of 'adjust' ----- > fmap f = mapped %~ f--- > fmapDefault f = traverse %~ f+-- @'fmap' f = 'mapped' '%~' f@ ----- > ghci> _2 %~ length $ (1,"hello")--- > (1,5)+-- @'Data.Traversable.fmapDefault' f = 'traverse' '%~' f@ --+-- >>> import Control.Lens+-- >>> _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@@ -242,11 +256,11 @@ -- -- This is an infix version of 'set', provided for consistency with ('.=') -------- > f <$ a = mapped .~ f $ a+-- @f '<$' a = 'mapped' '.~' f '$' a@ ----- > ghci> bitAt 0 .~ True $ 0--- > 1+-- >>> import Control.Lens+-- >>> _1 .~ "hello" $ (42,"world")+-- ("hello","world") -- -- > (.~) :: Setter a b c d    -> d -> a -> b -- > (.~) :: Iso a b c d       -> d -> a -> b@@ -267,14 +281,16 @@  -- | Increment the target(s) of a numerically valued 'Control.Lens.Type.Lens', 'Setter' or 'Control.Lens.Traversal.Traversal' ----- > ghci> _1 +~ 1 $ (1,2)--- > (2,2)+-- >>> import Control.Lens+-- >>> _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 'Control.Lens.Type.Lens', 'Control.Lens.Iso.Iso', 'Setter' or 'Control.Lens.Traversal.Traversal' --+-- >>> import Control.Lens -- >>> _2 *~ 4 $ (1,2) -- (1,8) (*~) :: Num c => Setting a b c c -> c -> a -> b@@ -283,6 +299,7 @@  -- | Decrement the target(s) of a numerically valued 'Control.Lens.Type.Lens', 'Control.Lens.Iso.Iso', 'Setter' or 'Control.Lens.Traversal.Traversal' --+-- >>> import Control.Lens -- >>> _1 -~ 2 $ (1,2) -- (-1,2) (-~) :: Num c => Setting a b c c -> c -> a -> b@@ -295,6 +312,7 @@  -- | Raise the target(s) of a numerically valued 'Control.Lens.Type.Lens', 'Setter' or 'Control.Lens.Traversal.Traversal' to a non-negative integral power --+-- >>> import Control.Lens -- >>> _2 ^~ 2 $ (1,3) -- (1,9) (^~) :: (Num c, Integral e) => Setting a b c c -> e -> a -> b@@ -303,6 +321,7 @@  -- | Raise the target(s) of a fractionally valued 'Control.Lens.Type.Lens', 'Setter' or 'Control.Lens.Traversal.Traversal' to an integral power --+-- >>> import Control.Lens -- >>> _2 ^^~ (-1) $ (1,2) -- (1,0.5) (^^~) :: (Fractional c, Integral e) => Setting a b c c -> e -> a -> b@@ -311,6 +330,7 @@  -- | Raise the target(s) of a floating-point valued 'Control.Lens.Type.Lens', 'Setter' or 'Control.Lens.Traversal.Traversal' to an arbitrary power. --+-- >>> import Control.Lens -- >>> _2 **~ pi $ (1,3) -- (1,31.54428070019754) (**~) :: Floating c => Setting a b c c -> c -> a -> b@@ -349,7 +369,7 @@ l .= b = State.modify (l .~ b) {-# INLINE (.=) #-} --- | Map over the target of a 'Control.Lens.Type.Lens' or all of the targets of a 'Setter' or 'Traversal in our monadic state.+-- | Map over the target of a 'Control.Lens.Type.Lens' or all of the targets of a 'Setter' or 'Control.Lens.Traversal.Traversal' in our monadic state. -- -- > (%=) :: MonadState a m => Iso a a c d             -> (c -> d) -> m () -- > (%=) :: MonadState a m => Lens a a c d            -> (c -> d) -> m ()@@ -433,7 +453,7 @@ -- > do foo <~ bar -- >    ... ----- will store the result in a lens/setter/traversal.+-- will store the result in a 'Control.Lens.Type.Lens', 'Setter', or 'Control.Lens.Traversal.Traversal'. (<~) :: MonadState a m => Setting a a c d -> m d -> m () l <~ md = md >>= (l .=) {-# INLINE (<~) #-}@@ -468,11 +488,3 @@ 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/Type.hs view
@@ -19,30 +19,30 @@ -- -- A @'Lens' a b c d@ is a purely functional reference. ----- While a 'Traversal' could be used for 'Getting' like a valid 'Fold',+-- While a 'Control.Lens.Traversal.Traversal' could be used for 'Control.Lens.Getter.Getting' like a valid 'Control.Lens.Fold.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+-- @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' is a valid 'Setter', choosing @f@ = 'Control.Lens.Getter.Mutator'. ----- Every 'Lens' can be used for 'Getting' like a 'Fold' that doesn't use--- the 'Monoid'.+-- Every 'Lens' can be used for 'Control.Lens.Getter.Getting' like a 'Control.Lens.Fold.Fold' that doesn't use+-- the 'Applicative' or 'Control.Lens.Getter.Gettable'. ----- Every 'Lens' is a valid 'Traversal' that only uses the 'Functor' part+-- Every 'Lens' is a valid 'Control.Lens.Traversal.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@+-- Every 'Lens' can be used for 'Control.Lens.Getter.Getting' like a valid 'Getter', since 'Functor' is+-- a superclass of 'Control.Lens.Getter.Gettable' ----- Since every 'Lens' can be used for 'Getting' like a valid 'Getter' it+-- Since every 'Lens' can be used for 'Control.Lens.Getter.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'.+-- a 'Data.Traversable.Traversable' when used as a 'Control.Lens.Traversal.Traversal'. ---------------------------------------------------------------------------- module Control.Lens.Type   (@@ -95,6 +95,7 @@ infixr 4 <+~, <*~, <-~, <//~, <^~, <^^~, <**~, <&&~, <||~, <%~, <<>~ infix  4 <+=, <*=, <-=, <//=, <^=, <^^=, <**=, <&&=, <||=, <%=, <<>= + -------------------------- -- Lenses --------------------------@@ -105,50 +106,52 @@ -- -- 1) You get back what you put in: ----- > view l (set l b a)  = b+-- @'view' l ('set' l b a)  = b@ -- -- 2) Putting back what you got doesn't change anything: ----- > set l (view l a) a  = a+-- @'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+-- @'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'.+-- Every 'Lens' can be used directly as a 'Setter' or 'Control.Lens.Traversal.Traversal'. ----- You can also use a 'Lens' for 'Getting' as if it were a 'Fold' or 'Getter'.+-- You can also use a 'Lens' for 'Control.Lens.Getter.Getting' as if it were a 'Control.Lens.Fold.Fold' or 'Getter'. ----- Since every lens is a valid 'Traversal', the traversal laws should also apply to any lenses you create.+-- Since every lens is a valid 'Control.Lens.Traversal.Traversal', the traversal laws should also apply to any lenses you create. -- -- 1.) Idiomatic naturality: ----- > l pure = pure+-- @l 'pure' = 'pure'@ -- -- 2.) Sequential composition: ----- > fmap (l f) . l g = getCompose . l (Compose . fmap f . g)+-- @'fmap' (l f) . l g = 'Data.Functor.Compose.getCompose' . l ('Data.Functor.Compose.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 => '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', ...+-- | A 'Simple' 'Lens', 'Simple' 'Control.Lens.Traversal.Traversal', ... can be used instead of a 'Lens','Control.Lens.Traversal.Traversal', ... -- whenever the type variables don't change upon setting a value. ----- > imaginary :: Simple Lens (Complex a) a--- > traverseHead :: Simple Traversal [a] a+-- @+-- 'Data.Complex.Lens.imaginary' :: 'Simple' 'Lens' ('Data.Complex.Complex' a) a+-- 'Data.List.Lens.traverseHead' :: 'Simple' 'Control.Lens.Lens.Traversal' [a] a+-- @ ----- Note: To use this alias in your own code with @'LensLike' f@ or @Setter@, you may have to turn on+-- Note: To use this alias in your own code with @'LensLike' f@ or 'Control.Lens.Setter.Setter', you may have to turn on -- @LiberalTypeSynonyms@. type Simple f a b = f a a b b --- | > type SimpleLens = Simple Lens+-- | @type 'SimpleLens' = 'Simple' 'Lens'@ type SimpleLens a b = Lens a a b b --- | > type SimpleLensLike f = Simple (LensLike f)+-- | @type 'SimpleLensLike' f = 'Simple' ('LensLike' f)@ type SimpleLensLike f a b = LensLike f a a b b  --------------------------@@ -167,13 +170,13 @@ --------------------------  -- |--- Many combinators that accept a 'Lens' can also accept a 'Traversal' in limited situations.+-- Many combinators that accept a 'Lens' can also accept a 'Control.Lens.Traversal.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'.+-- Further, if @f@ is an 'Applicative', they may also be passed a 'Control.Lens.Traversal.Traversal'. type LensLike f a b c d = (c -> f d) -> a -> f b  -- | ('%%~') can be used in one of two scenarios:@@ -181,12 +184,12 @@ -- 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+-- When applied to a 'Control.Lens.Traversal.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+-- @('%%~') = '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@@ -194,7 +197,7 @@ -- -- 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+-- When applied to a 'Control.Lens.Traversal.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)@@ -205,10 +208,10 @@ {-# 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@+-- modify all targets of a 'Control.Lens.Traversal.Traversal' in the current state, extracting extra information of type @c@ -- and return a monoidal summary of the changes. ----- > (%%=) = (state.)+-- @('%%=') = ('state' '.')@ -- -- It may be useful to think of ('%%='), instead, as having either of the following more restricted -- type signatures:@@ -229,11 +232,11 @@  -- | 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'.+  -- | Run a monadic action in a larger context than it was defined in, using a 'Simple' 'Lens' or 'Simple' 'Control.Lens.Traversal.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+  -- When applied to a 'Simple 'Control.Lens.Traversal.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.@@ -286,24 +289,28 @@ -- | This is a lens that can change the value (and type) of the first field of -- a pair. ----- > ghci> (1,2)^._1--- > 1+-- >>> import Control.Lens ----- > ghci> _1 +~ "hello" $ (1,2)--- > ("hello",2)+-- >>> (1,2)^._1+-- 1 ----- > _1 :: Functor f => (a -> f b) -> (a,c) -> f (a,c)+-- >>> _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+-- @+-- 'Control.Lens.Fold.anyOf' '_2' :: (c -> 'Bool') -> (a, c) -> 'Bool'+-- 'Data.Traversable.traverse' '.' '_2' :: ('Applicative' f, 'Data.Traversable.Traversable' t) => (a -> f b) -> t (c, a) -> f (t (c, b))+-- 'Control.Lens.Fold.foldMapOf' ('Data.Traversable.traverse' '.' '_2') :: ('Data.Traversable.Traversable' t, 'Data.Monoid.Monoid' m) => (c -> m) -> t (b, c) -> m+-- @ ----- > _2 :: Functor f => (a -> f b) -> (c,a) -> f (c,b)+-- @_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 #-}@@ -337,11 +344,11 @@ -- | -- -- Cloning a 'Lens' is one way to make sure you arent given--- something weaker, such as a 'Traversal' and can be used+-- something weaker, such as a 'Control.Lens.Traversal.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.+-- (admissable) 'Applicative' instance. -- clone :: Functor f       => LensLike (IndexedStore c d) a b c d@@ -354,10 +361,10 @@ -- Overloading function application ----------------------------------------------------------------------------- --- | > type LensLike f a b c d = Overloaded (->) f a b c d+-- | @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 = 'Simple' ('Overloaded' k f) a b@ type SimpleOverloaded k f a b = Overloaded k f a a b b  -----------------------------------------------------------------------------@@ -385,9 +392,9 @@ l <-~ c = l <%~ subtract c {-# INLINE (<-~) #-} --- | Decrement the target of a numerically valued 'Lens' and return the result+-- | Multiply the target of a numerically valued 'Lens' and return the result ----- When you do not need the result of the subtraction, ('*~') is more flexible.+-- When you do not need the result of the multiplication, ('*~') is more flexible. (<*~) :: Num c => LensLike ((,)c) a b c c -> c -> a -> (c, b) l <*~ c = l <%~ (* c) {-# INLINE (<*~) #-}@@ -445,7 +452,7 @@ -- Setting and Remembering State ----------------------------------------------------------------------------- --- | Modify the target of a ' into your monad's state by a user supplied function and return the result.+-- | Modify the target of a 'Lens' into your monad's state by a user supplied function and return the result. -- -- When you do not need the result of the operation, ('%=') is more flexible. (<%=) :: MonadState a m => LensLike ((,)d) a a c d -> (c -> d) -> m d
src/Control/Parallel/Strategies/Lens.hs view
@@ -24,39 +24,46 @@ -- | Evaluate the targets of a 'Lens' or 'Traversal' into a data structure -- according to the given strategy. ----- > evalTraversable = evalTraversal traverse------ > evalTraversal = id------ > evalTraversal :: Simple Lens a b -> Strategy b -> Strategy a--- > evalTraversal :: Simple Traversal a b -> Strategy b -> Strategy a+-- @+-- 'evalTraversable' = 'evalTraversal' 'traverse' = 'traverse'+-- 'evalTraversal' = 'id'+-- @ ----- > evalTraversal :: (b -> Eval b) -> a -> Eval a) -> Strategy b -> Strategy a+-- @+-- evalTraversal :: 'Simple' 'Lens' a b -> 'Strategy' b -> 'Strategy' a+-- evalTraversal :: 'Simple' 'Traversal' a b -> 'Strategy' b -> 'Strategy' a+-- evalTraversal :: (b -> 'Eval' b) -> a -> 'Eval' a) -> 'Strategy' b -> 'Strategy' a+-- @ evalOf :: LensLike Eval a a b b -> Strategy b -> Strategy a evalOf l = l  -- | Evaluate the targets of a 'Lens' or 'Traversal' according into a -- data structure according to a given 'Strategy' in parallel. ----- > parTraversable = parTraversal traverse------ > parTraversal :: Simple Lens a b -> Strategy b -> Strategy a--- > parTraversal :: Simple Traversal a b -> Strategy b -> Strategy a+-- @'parTraversable' = 'parTraversal' 'traverse'@ ----- > parTraversal :: ((b -> Eval b) -> a -> Eval a) -> Strategy b -> Strategy a+-- @+-- parTraversal :: 'Simple' 'Lens' a b -> 'Strategy' b -> 'Strategy' a+-- parTraversal :: 'Simple' 'Traversal' a b -> 'Strategy' b -> 'Strategy' a+-- parTraversal :: ((b -> 'Eval' b) -> a -> 'Eval' a) -> 'Strategy' b -> 'Strategy' a+-- @ parOf :: LensLike Eval a a b b -> Strategy b -> Strategy a parOf l s = l (rparWith s)  -- | Transform a 'Lens', 'Fold', 'Getter', 'Setter' or 'Traversal' to--- first evaluates its argument according to a given strategy, before proceeding.+-- first evaluates its argument according to a given strategy /before/ proceeding. ----- > after rdeepseq traverse+-- @+-- 'after' 'rdeepseq' 'traverse' :: 'Traversable' t => 'Strategy' a -> 'Strategy' [a]+-- @ after :: Strategy a -> LensLike f a b c d -> LensLike f a b c d after s l f = l f $| s  -- | Transform a 'Lens', 'Fold', 'Getter', 'Setter' or 'Traversal' to--- evaluate its argument according to a given strategy in parallel with evaluating.+-- evaluate its argument according to a given strategy /in parallel with/ evaluating. ----- > meanwhile rdeepseq traverse+-- @+-- 'meanwhile' 'rdeepseq' 'traverse' :: 'Traversable' t => 'Strategy' a -> 'Strategy' [a]+-- @ meanwhile :: Strategy a -> LensLike f a b c d -> LensLike f a b c d meanwhile s l f = l f $|| s
src/Data/Array/Lens.hs view
@@ -27,35 +27,38 @@  -- | Access an element of an array. ----- Note: The indexed element is assumed to exist in the target array.+-- Note: The indexed element is assumed to exist in the target 'IArray'. ----- > arr ! i = arr^.ix i--- > arr // [(i,e)] = ix i ^= e $ arr+-- @arr '!' i = arr '^.' 'ix' i@ ----- >>> ix 2 ^= 9 $ listArray (1,5) [4,5,6,7,8]--- array (1,5) [4,9,6,7,8]+-- @arr '//' [(i,e)] = 'ix' i '.~' e '$' arr@+--+-- >>> ix 2 .~ 9 $ (listArray (1,5) [4,5,6,7,8] :: Array Int Int)+-- array (1,5) [(1,4),(2,9),(3,6),(4,7),(5,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 derive a new array from an old array by--- applying a function to each of the indices.+-- | This setter can be used to derive a new 'IArray' from an old array by+-- applying a function to each of the indices to look it up in the old 'IArray'. -- -- This is a /contravariant/ 'Setter'. ----- > ixmap = adjust . ixmapped--- > ixmapped = sets . ixmap+-- @'ixmap' = 'adjust' . 'ixmapped'@ ----- > adjust (ixmapped b) f arr ! i = arr ! f i--- > bounds (adjust (ixmapped b) f arr) = b+-- @'ixmapped' = 'sets' . 'ixmap'@+--+-- @'adjust' ('ixmapped' b) f arr '!' i = arr '!' f i@+--+-- @'bounds' ('adjust' ('ixmapped' b) f arr) = b@ ixmapped :: (IArray a e, Ix i, Ix j) => (i,i) -> Setter (a j e) (a i e) i j ixmapped = sets . ixmap {-# INLINE ixmapped #-} --- | Generic 'IndexedTraversal' of the elements of an array, using the index into the--- array as the index of the traversal.+-- | An 'IndexedTraversal' of the elements of an 'IArray', using the +-- index into the array as the index of the traversal. ----- > amap = adjust traverseArray+-- @'amap' = 'adjust' 'traverseArray'@ 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
@@ -6,7 +6,7 @@ -- Copyright   :  (C) 2012 Edward Kmett -- License     :  BSD-style (see the file LICENSE) -- Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  provisional+-- Stability   :  experimental -- Portability :  LiberalTypeSynonyms -- ----------------------------------------------------------------------------@@ -53,26 +53,27 @@  -- | This lens can be used to access the value of the nth bit in a number. ----- @bitAt 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)+bitAt :: Bits b => Int -> SimpleIndexedLens Int b Bool+bitAt n = index $ \f b -> (\x -> if x then setBit b n else clearBit b n) <$> f n (testBit b n) {-# INLINE bitAt #-}  -- | Traverse over all bits in a numeric type. -- -- The bit position is available as the index. --+-- >>> import Data.Word -- >>> 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.+-- If you supply this an 'Integer', the result will+-- be an infinite 'Traversal' that can be productively consumed. traverseBits :: Bits b => SimpleIndexedTraversal Int b Bool traverseBits = index $ \f b -> let     g n      = (,) n <$> f n (testBit b n)
src/Data/ByteString/Lazy/Lens.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE FlexibleContexts #-} ----------------------------------------------------------------------------- -- | -- Module      :  Data.ByteString.Lazy.Lens@@ -17,12 +18,14 @@ import Control.Lens import Data.ByteString.Lazy as Words import Data.ByteString.Lazy.Char8 as Char8+import Data.List.Lens import Data.Word (Word8) --- | Pack (or unpack) a list of bytes into a 'ByteString'+-- | 'Data.ByteString.Lazy.pack' (or 'Data.ByteString.Lazy.unpack') a list of bytes into a 'ByteString' ----- > pack x = x^.packedBytes--- > unpack x = x^.from packedBytes+-- @'Data.ByteString.Lazy.pack' x = x '^.' 'packedBytes'@+--+-- @'Data.ByteString.Lazy.unpack' x = x '^.' 'from' 'packedBytes'@ packedBytes :: Simple Iso [Word8] ByteString packedBytes = iso Words.pack Words.unpack {-# INLINE packedBytes #-}@@ -30,20 +33,21 @@  -- | Traverse the individual bytes in a 'ByteString' ----- > bytes = from packedBytes . traverse+-- @'bytes' = 'from' 'packedBytes' . 'traverseList'@ ----- > anyOf bytes (==0x80) :: ByteString -> Bool-bytes :: Simple Traversal ByteString Word8-bytes = from packedBytes . traverse+-- @'anyOf' 'bytes' ('==' 0x80) :: 'ByteString' -> 'Bool'@+bytes :: SimpleIndexedTraversal Int ByteString Word8+bytes = from packedBytes .> traverseList {-# INLINE bytes #-} --- | Pack (or unpack) a list of characters into a 'ByteString'+-- | 'Data.ByteString.Lazy.Char8.pack' (or 'Data.ByteString.Lazy.Char8.unpack') a list of characters into a 'ByteString' ----- When writing back to the byteString it is assumed that all characters--- lie between '\x00' and '\xff'.+-- When writing back to the 'ByteString' it is assumed that every 'Char'+-- lies between '\x00' and '\xff'. ----- > pack x = x^.packedChars--- > unpack x = x^.from packedChars+-- @'Data.ByteString.Lazy.Char8.pack' x = x '^.' 'packedChars'@+--+-- @'Data.ByteString.Lazy.Char8.unpack' x = x '^.' 'from' 'packedChars'@ packedChars :: Simple Iso String ByteString packedChars = iso Char8.pack Char8.unpack {-# INLINE packedChars #-}@@ -51,12 +55,12 @@  -- | Traverse the individual bytes in a 'ByteString' as characters. ----- When writing back to the byteString it is assumed that all characters--- lie between '\x00' and '\xff'.+-- When writing back to the 'ByteString' it is assumed that every 'Char'+-- lies between '\x00' and '\xff'. ----- > chars = from packed . traverse+-- @'chars' = 'from' 'packedChars' '.>' 'traverseList'@ ----- > anyOf chars (=='c') :: ByteString -> Bool-chars :: Simple Traversal ByteString Char-chars = from packedChars . traverse+-- @'anyOf' 'chars' ('==' \'c\') :: 'ByteString' -> 'Bool'@+chars :: SimpleIndexedTraversal Int ByteString Char+chars = from packedChars .> traverseList {-# INLINE chars #-}
src/Data/ByteString/Lens.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE FlexibleContexts #-} ----------------------------------------------------------------------------- -- | -- Module      :  Data.ByteString.Lens@@ -16,33 +17,36 @@ import Control.Lens import Data.ByteString as Words import Data.ByteString.Char8 as Char8+import Data.List.Lens import Data.Word (Word8) --- | Pack (or unpack) a list of bytes into a 'ByteString'+-- | 'Data.ByteString.pack' (or 'Data.ByteString.unpack') a list of bytes into a 'ByteString' ----- > pack x = x^.packedBytes--- > unpack x = x^.from packedBytes+-- @'Data.ByteString.pack' x = x '^.' 'packedBytes'@+--+-- @'Data.ByteString.unpack' x = x '^.' 'from' 'packedBytes'@ packedBytes :: Simple Iso [Word8] ByteString packedBytes = iso Words.pack Words.unpack {-# INLINE packedBytes #-} {-# SPECIALIZE packedBytes :: Simple Lens [Word8] ByteString #-} --- | Traverse the individual bytes in a 'ByteString'+-- | Traverse each 'Word8' in a 'ByteString' ----- > bytes = from packedBytes . traverse+-- @'bytes' = 'from' 'packedBytes' '.>' 'traverseList'@ ----- > anyOf bytes (==0x80) :: ByteString -> Bool-bytes :: Simple Traversal ByteString Word8-bytes = from packedBytes . traverse+-- @'anyOf' 'bytes' ('==' 0x80) :: 'ByteString' -> 'Bool'@+bytes :: SimpleIndexedTraversal Int ByteString Word8+bytes = from packedBytes .> traverseList {-# INLINE bytes #-} --- | Pack (or unpack) a list of characters into a 'ByteString'+-- | 'Data.ByteString.Char8.pack' (or 'Data.ByteString.Char8.unpack') a list of characters into a 'ByteString' ----- When writing back to the byteString it is assumed that all characters--- lie between '\x00' and '\xff'.+-- When writing back to the 'ByteString' it is assumed that every 'Char'+-- lies between '\x00' and '\xff'. ----- > pack x = x^.packedChars--- > unpack x = x^.from packedChars+-- @'Data.ByteString.Char8.pack' x = x '^.' 'packedChars'@+--+-- @'Data.ByteString.Char8.unpack' x = x '^.' 'from' 'packedChars'@ packedChars :: Simple Iso String ByteString packedChars = iso Char8.pack Char8.unpack {-# INLINE packedChars #-}@@ -50,12 +54,12 @@  -- | Traverse the individual bytes in a 'ByteString' as characters. ----- When writing back to the byteString it is assumed that all characters--- lie between '\x00' and '\xff'.+-- When writing back to the 'ByteString' it is assumed that every 'Char'+-- lies between '\x00' and '\xff'. ----- > chars = from packed . traverse+-- @'chars' = 'from' 'packed' . 'traverse'@ ----- > anyOf chars (=='c') :: ByteString -> Bool-chars :: Simple Traversal ByteString Char-chars = from packedChars . traverse+-- @'anyOf' 'chars' ('==' \'c\') :: 'ByteString' -> 'Bool'@+chars :: SimpleIndexedTraversal Int ByteString Char+chars = from packedChars .> traverseList {-# INLINE chars #-}
src/Data/Complex/Lens.hs view
@@ -5,8 +5,8 @@ -- Copyright   :  (C) 2012 Edward Kmett -- License     :  BSD-style (see the file LICENSE) -- Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  provisional--- Portability :  Haskell2010+-- Stability   :  experimental+-- Portability :  Rank2Types -- ---------------------------------------------------------------------------- module Data.Complex.Lens@@ -18,7 +18,7 @@ import Control.Lens import Data.Complex --- | Access the real part of a complex number+-- | Access the 'realPart' of a 'Complex' number -- -- > real :: Functor f => (a -> f a) -> Complex a -> f (Complex a) #if MIN_VERSION_base(4,4,0)@@ -28,7 +28,7 @@ #endif real f (a :+ b) = (:+ b) <$> f a --- | Access the imaginary part of a complex number+-- | Access the 'imaginaryPart' of a 'Complex' number -- -- > imaginary :: Functor f => (a -> f a) -> Complex a -> f (Complex a) #if MIN_VERSION_base(4,4,0)@@ -38,16 +38,20 @@ #endif imaginary f (a :+ b) = (a :+) <$> f b --- | This isn't /quite/ a legal lens. Notably the @view l (set l b a) = b@ law--- is violated when you set a polar value with 0 magnitude and non-zero phase--- as the phase information is lost. So don't do that! Otherwise, this is a--- perfectly cromulent lens.+-- | This isn't /quite/ a legal lens. Notably the +--+-- @'view' l ('set' l b a) = b@+--+-- law is violated when you set a 'polar' value with 0 'magnitude' and non-zero 'phase'+-- as the 'phase' information is lost. So don't do that!+--+-- Otherwise, this is a perfectly cromulent 'Lens'.  polarize :: (RealFloat a, RealFloat b) => Iso (Complex a) (Complex b) (a,a) (b,b) polarize = isos polar (uncurry mkPolar)                 polar (uncurry mkPolar) --- | Traverse both the real and imaginary parts of a complex number.+-- | Traverse both the real and imaginary parts of a 'Complex' number. -- -- > traverseComplex :: Applicative f => (a -> f b) -> Complex a -> f (Complex b) #if MIN_VERSION_base(4,4,0)
src/Data/IntMap/Lens.hs view
@@ -34,10 +34,10 @@ -- fromList [(1,"hello")] -- -- > at :: Int -> (Maybe v -> f (Maybe v)) -> IntMap v -> f (IntMap v)-at :: Int -> Simple Lens (IntMap v) (Maybe v)-at k f m = go <$> f (IntMap.lookup k m) where-  go Nothing   = IntMap.delete k m-  go (Just v') = IntMap.insert k v' m+at :: Int -> SimpleIndexedLens Int (IntMap v) (Maybe v)+at k = index $ \ f m -> (`go` m) <$> f k (IntMap.lookup k m) where+  go Nothing   = IntMap.delete k+  go (Just v') = IntMap.insert k v' {-# INLINE at #-}  -- | Traversal of an 'IntMap' indexed by the key.@@ -49,8 +49,8 @@ -- -- > traverseAt :: Applicative f => Int -> (v -> f v) -> IntMap v -> f (IntMap v) -- > traverseAt k = at k . traverse-traverseAt :: Int -> Simple Traversal (IntMap v) v-traverseAt k = at k . traverse+traverseAt :: Int -> SimpleIndexedTraversal Int (IntMap v) v+traverseAt k = at k <. traverse {-# INLINE traverseAt #-}  -- | Traverse the value at the minimum key in a Map
src/Data/Map/Lens.hs view
@@ -1,7 +1,6 @@ {-# LANGUAGE Rank2Types #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LiberalTypeSynonyms #-}-{-# OPTIONS_GHC -fno-warn-unused-imports #-} ----------------------------------------------------------------------------- -- | -- Module      :  Data.Map.Lens@@ -21,16 +20,17 @@   ) where  import Control.Applicative as Applicative-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 Control.Lens.IndexedLens+import Control.Lens.IndexedTraversal import Data.Map as Map import Data.Traversable  -- | This 'Lens' can be used to read, write or delete the value associated with a key in a 'Map'. --+-- >>> :m + Control.Lens Data.Map.Lens+-- -- >>> Map.fromList [("hello",12)] ^.at "hello" -- Just 12 --@@ -38,10 +38,10 @@ -- 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-  go Nothing   = Map.delete k m-  go (Just v') = Map.insert k v' m+at :: Ord k => k -> SimpleIndexedLens k (Map k v) (Maybe v)+at k = index $ \f m -> (`go` m) <$> f k (Map.lookup k m) where+  go Nothing   = Map.delete k+  go (Just v') = Map.insert k v' {-# INLINE at #-}  -- | Traversal of a 'Map' indexed by the key.@@ -52,8 +52,8 @@ -- -- > traverseAt :: (Applicative f, Ord k) => k -> (v -> f v) -> Map k v -> f (Map k v) -- > traverseAt k = valueAt k . traverse-traverseAt :: Ord k => k -> SimpleTraversal (Map k v) v-traverseAt k = at k . traverse+traverseAt :: Ord k => k -> SimpleIndexedTraversal k (Map k v) v+traverseAt k = at k <. traverse {-# INLINE traverseAt #-}  -- | Traverse the value at the minimum key in a Map.
src/Data/Set/Lens.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS_GHC -fno-warn-unused-imports #-} ----------------------------------------------------------------------------- -- | -- Module      :  Data.Set.Lens@@ -19,11 +18,11 @@ 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' --+-- >>> :m + Data.Set.Lens Control.Lens -- >>> contains 3 .~ False $ Set.fromList [1,2,3,4] -- fromList [1,2,4] --@@ -40,6 +39,7 @@ -- Sadly, you can't create a valid 'Traversal' for a 'Set', but you can -- manipulate it by reading using 'folded' and reindexing it via 'setmap'. --+-- >>> :m + Data.Set.Lens Control.Lens -- >>> 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@@ -47,6 +47,7 @@  -- | Construct a set from a 'Getter', 'Fold', 'Traversal', 'Lens' or 'Iso'. --+-- >>> :m + Data.Set.Lens Control.Lens -- >>> setOf (folded._2) [("hello",1),("world",2),("!!!",3)] -- fromList [1,2,3] --
src/GHC/Generics/Lens.hs view
@@ -10,38 +10,49 @@ -- Stability   :  experimental -- Portability :  GHC --+-- Note: @GHC.Generics@ exports a number of names that collide with @Control.Lens@.+--+-- You can use hiding or imports to mitigate this to an extent, and the following imports,+-- represent a fair compromise for user code:+--+-- > import Control.Lens hiding (Rep)+-- > import GHC.Generics hiding (from, to)+--+-- You can use 'generic' to replace 'GHC.Generics.from' and 'GHC.Generics.to' from @GHC.Generics@,+-- and probably won't be explicitly referencing 'Control.Lens.Representable.Rep' from @Control.Lens@+-- in code that uses generics. ---------------------------------------------------------------------------- module GHC.Generics.Lens   (-  -- * Conversion to/from generic+  -- * Isomorphisms for @GHC.Generics@     generic   , generic1-  -- * Generic Traversal+  -- * 'Generic' 'Traversal'   , every   , GTraversal   ) where -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+import           Control.Applicative+import           Control.Lens hiding (Rep)+import           Data.Maybe (fromJust)+import           Data.Typeable+import qualified GHC.Generics as Generic+import           GHC.Generics                     hiding (from, to)  -- | Convert from the data type to its representation (or back) ----- >>> "hello"^.generic.from generic+-- >>> "hello"^.generic.from generic :: String -- "hello" ---generic :: (Generic a, Generic b) => Iso a b (Rep a x) (Rep b y)-generic = isos from to from to+generic :: Generic a => Simple Iso a (Rep a b)+generic = iso Generic.from Generic.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+generic1 :: Generic1 f => Simple Iso (f a) (Rep1 f a)+generic1 = iso from1 to1 --- | Traverse using GHC.Generics.+-- | A 'GHC.Generics.Generic' 'Traversal' that visits every occurence+-- of something 'Typeable' anywhere in a container. -- -- >>> allOf every (=="Hello") (1::Int,2::Double,(),"Hello",["Hello"]) -- True@@ -52,7 +63,7 @@ every :: (Generic a, GTraversal (Rep a), Typeable b) => Simple Traversal a b every = generic . everyr True --- | Traversable generic data types. Used by 'every'.+-- | Used to traverse 'Generic' data by 'every'. class GTraversal f where   everyr :: Typeable b => Bool -> Simple Traversal (f a) b
test/doctests.hs view
@@ -7,10 +7,16 @@     "-isrc"   , "-idist/build/autogen"   , "-optP-include", "-optPdist/build/autogen/cabal_macros.h"-  , "src/Control/Lens.hs"+  , "src/Control/Lens/Action.hs"+  , "src/Control/Lens/Fold.hs"+  , "src/Control/Lens/Getter.hs"+  , "src/Control/Lens/Setter.hs"+  , "src/Data/Array/Lens.hs"+  , "src/Data/Bits/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"+  , "src/GHC/Generics/Lens.hs"   ]
+ test/properties.hs view
@@ -0,0 +1,90 @@+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE ExtendedDefaultRules #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Main where++import Control.Applicative+import Control.Monad+import Control.Lens+import Data.Functor.Identity+import System.Exit+import Test.QuickCheck+import Test.QuickCheck.All+import Test.QuickCheck.Function+import Data.Pair.Lens+import Data.Either.Lens+import Data.Text.Lens++setter_id :: Eq a => Simple Setter a b -> a -> Bool+setter_id l a = runIdentity (l Identity a) == a++setter_composition :: Eq a => Simple Setter a b -> a -> Fun b b -> Fun b b -> Bool+setter_composition l a (Fun _ f) (Fun _ g) = mapOf l f (mapOf l g a) == mapOf l (f . g) a++lens_set_view :: Eq a => Simple Lens a b -> a -> Bool+lens_set_view l a = set l (a^.l) a == a++lens_view_set :: Eq b => Simple Lens a b -> a -> b -> Bool+lens_view_set l a b = set l b a^.l == b++traversal_set_set :: Eq a => Simple Traversal a b -> a -> b -> b -> Bool+traversal_set_set l a b c = set l c (set l b a) == set l c a++iso_hither :: Eq a => Simple Iso a b -> a -> Bool+iso_hither l a = a ^.l.from l == a++iso_yon :: Eq b => Simple Iso a b -> b -> Bool+iso_yon l b = b^.from l.l == b++isSetter :: (Arbitrary a, Arbitrary b, CoArbitrary b, Show a, Show b, Eq a, Function b)+         => Simple Setter a b -> Property+isSetter l = setter_id l .&. setter_composition l++isTraversal :: (Arbitrary a, Arbitrary b, CoArbitrary b, Show a, Show b, Eq a, Function b)+         => Simple Traversal a b -> Property+isTraversal l = isSetter l .&. traversal_set_set l++isLens :: (Arbitrary a, Arbitrary b, CoArbitrary b, Show a, Show b, Eq a, Eq b, Function b)+       => Simple Lens a b -> Property+isLens l = lens_set_view l .&. lens_view_set l .&. isTraversal l++isIso :: (Arbitrary a, Arbitrary b, CoArbitrary a, CoArbitrary b, Show a, Show b, Eq a, Eq b, Function a, Function b)+      => Simple Iso a b -> Property+isIso l = iso_hither l .&. iso_yon l .&. isLens l .&. isLens (from l)++-- an illegal lens+bad :: Simple Lens (Int,Int) Int+bad f (a,b) = (,) b <$> f a++badIso :: Simple Iso Int Bool+badIso = iso even fromEnum++-- Control.Lens.Type+prop_1                               = isLens (_1 :: Simple Lens (Int,Double) Int)+prop_2                               = isLens (_2 :: Simple Lens (Int,Bool) Bool)+prop_2_2                             = isLens (_2._2 :: Simple Lens (Int,(Int,Bool)) Bool)++prop_illegal_lens                    = expectFailure $ isLens bad+prop_illegal_traversal               = expectFailure $ isTraversal bad+prop_illegal_setter                  = expectFailure $ isSetter bad+prop_illegal_iso                     = expectFailure $ isIso badIso++-- Control.Lens.Setter+prop_mapped                          = isSetter (mapped :: Simple Setter [Int] Int)+prop_mapped_mapped                   = isSetter (mapped.mapped :: Simple Setter [Maybe Int] Int)++++prop_both                            = isTraversal (both :: Simple Traversal (Int,Int) Int)+prop_value (Fun _ k :: Fun Int Bool) = isTraversal (value k :: Simple Traversal (Int,Int) Int)+prop_traverseLeft                    = isTraversal (traverseLeft :: Simple Traversal (Either Int Bool) Int)+prop_traverseRight                   = isTraversal (traverseRight:: Simple Traversal (Either Int Bool) Bool)++-- Data.Text.Lens+prop_text s                          = s^.packed.from packed == s++main :: IO ()+main = do+  b <- $quickCheckAll+  unless b $ exitWith (ExitFailure 1)
+ test/templates.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-unused-binds #-}+-- | The commented code summarizes what will be auto-generated below+module Main where++import Control.Lens+-- import Test.QuickCheck (quickCheck)++-- newtype Foo a = Foo a+-- makeIso ''Foo+-- foo :: Iso a b (Foo a) (Foo b)++data Bar a b c = Bar { _baz :: (a, b) }+makeLenses ''Bar+-- baz :: Lens (Bar a b c) (Bar a' b' c) (a,b) (a',b')++data Quux a b = Quux { _quaffle :: Int, _quartz :: Double }+makeLenses ''Quux+-- quaffle :: Lens (Quux a b) (Quux a' b') Int Int+-- quartz :: Lens (Quux a b) (Quux a' b') Double Double++data Quark a = Qualified  { _gaffer :: a }+             | Unqualified { _gaffer :: a, tape :: a }+makeLenses ''Quark+-- gaffer :: Simple Lens (Quark a) a++data LensCrafted a = Still { _still :: a }+                   | Works { _still :: a }+makeLenses ''LensCrafted+-- still :: Lens (LensCrafted a) (LensCrafted b) a b++data Mono = Mono { _monoFoo :: Int, _monoBar :: Int }+makeClassy ''Mono+-- class HasMono t where+--   mono :: Simple Lens t Mono+-- instance HasMono Mono where+--   mono = id+-- monoFoo :: HasMono t => Simple Lens t Int+-- monoBar :: HasMono t => Simple Lens t Int++data Nucleosis = Nucleosis { _nuclear :: Mono }+makeClassy ''Nucleosis+-- class HasNucleosis t where+--   nucleosis :: Simple Lens t Nucleosis+-- instance HasNucleosis Nucleosis+-- nuclear :: HasNucleosis t => Simple Lens t Mono++instance HasMono Nucleosis where+  mono = nuclear++main :: IO ()+main = putStrLn "test/templates.hs: ok"