packages feed

lens 1.0.3 → 1.1

raw patch · 16 files changed

+927/−441 lines, 16 filesdep +arraydep +paralleldep ~base

Dependencies added: array, parallel

Dependency ranges changed: base

Files

lens.cabal view
@@ -1,6 +1,6 @@ name:          lens category:      Data, Lenses-version:       1.0.3+version:       1.1 license:       BSD3 cabal-version: >= 1.6 license-file:  LICENSE@@ -11,7 +11,126 @@ bug-reports:   http://github.com/ekmett/lens/issues copyright:     Copyright (C) 2012 Edward A. Kmett synopsis:      Families of Lenses, Folds and Traversals-description:   Families of Lenses, Folds and Traversals+description:+  The combinators in @Control.Lens@ provide a highly generic toolbox for composing+  families of getters, folds, traversals, setters and lenses.+  .+  /Getter/+  .+  A @'Getter' a b c d@ is just any function @(a -> c)@, which we've flipped into continuation+  passing style, @forall r. (c -> r) -> a -> r@ and decorated with 'Const' to obtain+  .+  > type Getter a b c d = forall r. (c -> Const r d) -> a -> Const r b+  .+  Everything you can do with a function, you can do with a 'Getter', but note that because of the+  continuation passing style (.) composes them in the opposite order.+  .+  Since it is only a function, every 'Getter' obviously only retrieves a single value for a given+  input.+  .+  /Fold/+  .+  A @'Fold' a b c d@ is a generalization of something 'Foldable'. It allows you to+  extract multiple results from a container. A 'Foldable' container can be+  characterized by the behavior of @foldMap :: (Foldable t, Monoid m) => (c -> m) -> t c -> m@.+  Since we want to be able to work with monomorphic containers, we generalize this signature to+  @forall m. 'Monoid' m => (c -> m) -> a -> m@, and then decorate it with 'Const' to obtain+  .+  > type Fold a b c d = forall m. Monoid m => (c -> Const m d) -> a -> Const m b+  .+  Every 'Getter' is a valid 'Fold' that simply doesn't use the 'Monoid' it is passed.+  .+  Everything you can do with a 'Foldable' container, you can with with a 'Fold' and there are+  combinators that generalize the usual 'Foldable' operations in @Control.Lens@.+  .+  /Traversal/+  .+  A @'Traversal' a b c d@ is a generalization of 'traverse' from 'Traversable'. It allows+  you to traverse over a structure and change out its contents with monadic or+  applicative side-effects. Starting from+  @'traverse' :: ('Traversable' t, 'Applicative' f) => (c -> f d) -> t c -> f (t d)@,+  we monomorphize the contents and result to obtain+  .+  > type Traversal a b c d = forall f. Applicative f => (c -> f d) -> a -> f b+  .+  Every 'Traversal' can be used as a valid 'Fold', because given a 'Monoid' @m@, we have an 'Applicative' for @('Const' m)@.++  Everything you can do with a 'Traversable' container, you can with with a 'Traversal', and there+  are combinators that generalize the usual 'Traversable' operations in @Control.Lens@.+  .+  /Setter/+  .+  A @'Setter' a b c d@ is a generalization of 'fmap' from 'Functor'. It allows you to map into a+  structure and change out the contents, but it isn't strong enough to allow you to+  enumerate those contents. Starting with @fmap :: 'Functor' f => (c -> d) -> f c -> f d@+  we monomorphize the type to obtain @(c -> d) -> a -> b@ and then decorate it with 'Identity' to obtain+  .+  > type Setter a b c d = (c -> Identity d) -> a -> Identity b+  .+  Every 'Traversal' is a valid 'Setter', since 'Identity' is 'Applicative'.+  .+  Everything you can do with a 'Functor', you can do with a 'Setter', and there are combinators that+  generalize the usual 'Functor' operations in @Control.Lens@.+  .+  /Lens/+  .+  A @'Lens' a b c d@ is a purely functional reference.+  .+  While a 'Traversal' was a valid 'Fold', it wasn't a valid 'Getter'. To make the 'Applicative'+  for 'Const' it required a 'Monoid' for the argument we passed it, which a 'Getter' doesn't recieve.+  .+  However, the instance of 'Functor' for 'Const' requires no such thing. If we weaken the type+  requirement from 'Applicative' to 'Functor' for 'Traversal', we obtain +  .+  > type Lens a b c d = forall f. Functor f => (c -> f d) -> a -> f b+  .+  Every 'Lens' is a valid 'Setter', choosing @f@ = 'Identity'.+  .+  Every 'Lens' is a valid 'Fold' that doesn't use the 'Monoid' it is passed.+  .+  Every 'Lens' is a valid 'Traversal' that only uses the 'Functor' part of the 'Applicative' it is supplied.+  .+  Every 'Lens' is a valid 'Getter', choosing @f@ = 'Const' @r@ for an appropriate @r@+  .+  Since every 'Lens' is a valid 'Getter' it follows that it must view exactly one element in the structure.+  .+  The lens laws follow from this property and the desire for it to act like a 'Functor' when used as a 'Setter'.+  .+  /Composition/+  .+  Note that all of these types are type aliases, and you can compose these lenses with mere function compositon.+  .+  This is a generalization of the well-known trick for @(.).(.)@ or @fmap.fmap@, and their less well-known cousins+  @foldMap.foldMap@ @traverse.traverse@. It follows because each one is a function between values of type @(x -> f y)@+  and the composition takes the intersection of supplied functionality for you automatically!+  .+  /Lens Families/+  .+  For a longer description of why you should care about lenses, and an overview of why we use 4+  parameters a, b, c, and d instead of just 2, see <http://comonad.com/reader/2012/mirrored-lenses/>.+  .+  Sometimes you won't need the flexibility those extra parameters afford you and you can use+  .+  > type Simple f a b = f a a b b+  .+  to describe a 'Simple' 'Lens', 'Simple' 'Traversal' or 'Simple' 'Setter'.+  .+  /Avoiding Dependencies/+  .+  Note: If you merely want your library to /provide/ lenses you may not+  have to actually import /any/ lens library at all. For, say, a+  @'Simple' 'Lens' Bar Foo@, just export a function with the signature:+  .+  > foo :: Functor f => (Foo -> f Foo) -> Bar -> f Bar+  .+  and then you can compose it with other lenses using nothing more than @(.)@ from the Prelude.+  .+  /Deriving Lenses/+  .+  You can derive lenses automatically for many data types using 'Control.Lens.TH', and if a+  container is fully characterized by its lenses, you can use 'Control.Lens.Representable' to+  automatically derive 'Functor', 'Applicative', 'Monad', and 'Derivable'.+ build-type:    Simple tested-with:   GHC == 7.4.1 extra-source-files: .travis.yml@@ -22,16 +141,32 @@  library   exposed-modules:+    Control.Exception.Lens     Control.Lens     Control.Lens.Internal     Control.Lens.Representable     Control.Lens.TH+    Control.Parallel.Strategies.Lens+    Data.Array.Lens+    Data.Bits.Lens+    Data.ByteString.Lens+    Data.Complex.Lens+    Data.Dynamic.Lens+    Data.Map.Lens+    Data.IntMap.Lens+    Data.IntSet.Lens+    Data.Sequence.Lens+    Data.Set.Lens+    Data.Text.Lens+    Data.Tree.Lens    build-depends:+    array            == 0.4.*,     base             == 4.*,     bytestring       == 0.9.*,     containers       >= 0.3   && < 0.6,     mtl              >= 2.1.1 && < 2.2,+    parallel         == 3.2.*,     template-haskell >= 2.4   && < 2.8,     text             == 0.11.*,     transformers     >= 0.2   && < 0.4@@ -39,6 +174,7 @@   other-extensions:     CPP     LiberalTypeSynonyms+    MultiParamTypeClasses     Rank2Types     RankNTypes     TemplateHaskell
+ src/Control/Exception/Lens.hs view
@@ -0,0 +1,29 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Exception.Lens+-- Copyright   :  (C) 2012 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+----------------------------------------------------------------------------+module Control.Exception.Lens+  ( traverseException+  ) where++import Control.Applicative+import Control.Exception+import Control.Lens++-- |+-- 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 :: (Exception a, Exception b) => Traversal SomeException SomeException a b+traverseException f e = case fromException e of+  Just a -> toException <$> f a+  Nothing -> pure e+{-# INLINE traverseException #-}
src/Control/Lens.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE LiberalTypeSynonyms #-} -----------------------------------------------------------------------------@@ -69,45 +70,36 @@   , scanr1Of, scanl1Of    -- ** Common Lenses-  , valueAt, valueAtInt-  , contains, containsInt-  , bitAt-  , resultAt-  , identity-  , real, imaginary, polarize   , _1, _2+  , identity+  , resultAt    -- * Setters   , Setter   , SimpleSetter   , sets   , mapped--  -- ** Setting Values   , adjust   , set-  , (^~), (+~), (-~), (*~), (//~), (||~), (&&~), (|~), (&~), (%~), (<>~)--  -- ** Setting State-  , (^=), (+=), (-=), (*=), (//=), (||=), (&&=), (|=), (&=), (%=), (<>=)+  , (^~), (+~), (-~), (*~), (//~), (||~), (&&~), (%~), (<>~)+  , (^=), (+=), (-=), (*=), (//=), (||=), (&&=), (%=), (<>=)+  , whisper    -- * Getters and Folds   , Getter   , Fold   , Getting-   , to-   , folding   , folded   , filtered   , reversed   , takingWhile   , droppingWhile-   , view, views   , (^.), (^$)   , use, uses+  , query, queries    -- ** Getting and Folding   , foldMapOf, foldOf@@ -132,63 +124,37 @@   , foldrMOf, foldlMOf    -- * Common Traversals+  , Traversable(..)   , traverseNothing-  , traverseLeft, traverseRight-  , traverseValueAt, traverseValueAtInt-  , traverseHead, traverseTail-  , traverseLast, traverseInit-  , TraverseByteString(..)-  , TraverseText(..)-  , TraverseValueAtMin(..)-  , TraverseValueAtMax(..)-  , traverseBits-  , traverseDynamic-  , traverseException-  , traverseElement, traverseElements+  , traverseLeft+  , traverseRight   , traverseValue    -- * Transforming Traversals-  , elementOf-  , elementsOf   , backwards-  , taking-  , dropping    -- * Cloning Lenses   , clone   ) where -import           Control.Applicative              as Applicative-import           Control.Exception                as Exception-import           Control.Lens.Internal-import           Control.Monad (liftM, MonadPlus(..), void)-import           Control.Monad.State.Class-import qualified Control.Monad.Trans.State.Lazy   as Lazy-import qualified Control.Monad.Trans.State.Strict as Strict-import           Control.Monad.Trans.Reader-import           Data.Bits-import           Data.ByteString.Lazy             as Lazy-import           Data.ByteString                  as Strict-import           Data.Complex-import           Data.Dynamic-import           Data.Foldable                    as Foldable-import           Data.Functor.Identity-import           Data.IntMap                      as IntMap hiding (adjust)-import           Data.IntSet                      as IntSet-import           Data.Map                         as Map    hiding (adjust)-import           Data.Maybe-import           Data.Monoid-import           Data.Sequence                    as Seq    hiding (adjust)-import           Data.Set                         as Set-import           Data.Text                        as StrictText-import           Data.Text.Lazy                   as LazyText-import           Data.Traversable-import           Data.Tree-import           Data.Word (Word8)+import Control.Applicative              as Applicative+import Control.Lens.Internal+import Control.Monad+import Control.Monad.Reader.Class       as Reader+import Control.Monad.State.Class        as State+import Control.Monad.Trans.State.Lazy   as Lazy+import Control.Monad.Trans.State.Strict as Strict+import Control.Monad.Trans.Reader+import Control.Monad.Writer.Class       as Writer+import Data.Foldable                    as Foldable+import Data.Functor.Identity+import Data.Maybe+import Data.Monoid+import Data.Traversable  infixl 8 ^.-infixr 4 ^~, +~, *~, -~, //~, &&~, ||~, &~, |~, %~, <>~, %%~-infix  4 ^=, +=, *=, -=, //=, &&=, ||=, &=, |=, %=, <>=, %%=+infixr 4 ^~, +~, *~, -~, //~, &&~, ||~, %~, <>~, %%~+infix  4 ^=, +=, *=, -=, //=, &&=, ||=, %=, <>=, %%= infixr 0 ^$  --------------------------@@ -218,8 +184,8 @@ -- -- > identity :: Lens (Identity a) (Identity b) a b -- > identity f (Identity a) = Identity <$> f a---- > type Lens = forall f. Functor f => Traversing f a b c d+--+-- > type Lens = forall f. Functor f => LensLike f a b c d type Lens a b c d = forall f. Functor f => (c -> f d) -> a -> f b  ------------------------------------------------------------------------------@@ -234,6 +200,10 @@ -- > traverse :: Traversable f => Traversal (f a) (f b) a b -- -- and the more evocative name suggests their application.+--+-- Most of the time the 'Traversal' you will want to use is just 'traverse', but you can also pass any+-- 'Lens' -- as a Traversal, and composition of a 'Traversal' (or 'Lens') with a 'Traversal' (or 'Lens')+-- using (.) forms a 'Traversal'. type Traversal a b c d = forall f. Applicative f => (c -> f d) -> a -> f b  -- | A @'Simple' 'Lens'@, @'Simple' 'Traversal'@, ... can be used instead of a 'Lens','Traversal', ...@@ -242,24 +212,17 @@ -- > imaginary :: Simple Lens (Complex a) a -- > traverseHead :: Simple Traversal [a] a ----- Note: If you plan to use this alias in your code, you may have to turn on------ > {-# LANGUAGE LiberalTypeSynonyms #-}+-- Note: To use this alias in your own code with @'LensLike' f@ or @Setter@, you may have to turn on+-- @LiberalTypeSynonyms@. type Simple f a b = f a a b b --- | This alias is supplied for those who don't want to use @{-# LANGUAGE LiberalTypeSynonyms #-}@ and 'Simple'------ > 'SimpleTraversal' = 'Simple' 'Traversal'+-- | > type SimpleTraversal = Simple Traversal type SimpleTraversal a b = Traversal a a b b --- | This alias is supplied for those who don't want to use @{-# LANGUAGE LiberalTypeSynonyms #-}@ and 'Simple'------ > 'SimpleLens' = 'Simple' 'Lens'+-- | > type SimpleLens = Simple Lens type SimpleLens a b = Lens a a b b --- | This alias is supplied for those who don't want to use @{-# LANGUAGE LiberalTypeSynonyms #-}@ and 'Simple'------ > 'SimpleLensLike' f = 'Simple' ('LensLike' f)+-- | > type SimpleLensLike f = Simple (LensLike f) type SimpleLensLike f a b = LensLike f a a b b  --------------------------@@ -326,7 +289,7 @@ -- > (%%=) :: MonadState a m             => Lens a a c d      -> (c -> (e, d) -> m e -- > (%%=) :: (MonadState a m, Monoid e) => Traversal a a c d -> (c -> (e, d) -> m e (%%=) :: MonadState a m => LensLike ((,) e) a a c d -> (c -> (e, d)) -> m e-l %%= f = state (l f)+l %%= f = State.state (l f) {-# INLINE (%%=) #-}  -- | This class allows us to use 'focus' on a number of different monad transformers.@@ -475,7 +438,7 @@ -- > mapAccumROf :: Lens a b c d      -> (s -> c -> (s, d)) -> s -> a -> (s, b) -- > mapAccumROf :: Traversal a b c d -> (s -> c -> (s, d)) -> s -> a -> (s, b) mapAccumROf :: LensLike (Lazy.State s) a b c d -> (s -> c -> (s, d)) -> s -> a -> (s, b)-mapAccumROf l f s0 a = swap (Lazy.runState (l (\c -> state (\s -> swap (f s c))) a) s0)+mapAccumROf l f s0 a = swap (Lazy.runState (l (\c -> State.state (\s -> swap (f s c))) a) s0) {-# INLINE mapAccumROf #-}  -- | Generalized 'Data.Traversable.mapAccumL' to an arbitrary 'Traversal'.@@ -642,16 +605,7 @@ l &&~ n = adjust l (&& n) {-# INLINE (&&~) #-} --- | Bitwise '.|.' the target(s) of a 'Bool'-valued 'Lens' or 'Setter'-(|~):: Bits c => Setter a b c c -> c -> a -> b-l |~ n = adjust l (.|. n)-{-# INLINE (|~) #-}---- | Bitwise '.&.' the target(s) of a 'Bool'-valued 'Lens' or 'Setter'-(&~) :: Bits c => Setter a b c c -> c -> a -> b-l &~ n = adjust l (.&. n)-{-# INLINE (&~) #-}-+-- | Modify the target of a monoidally valued by 'mappend'ing another value. (<>~) :: Monoid c => Setter a b c c -> c -> a -> b l <>~ n = adjust l (<> n) {-# INLINE (<>~) #-}@@ -791,69 +745,11 @@ _2 f (c,a) = (,) c <$> f a {-# INLINE _2 #-} --- | This 'Lens' can be used to read, write or delete the value associated with a key in a 'Map'.------ > ghci> Map.fromList [("hello",12)] ^. valueAt "hello"--- > Just 12------ > valueAt :: Ord k => k -> (Maybe v -> f (Maybe v)) -> Map k v -> f (Map k v)-valueAt :: Ord k => k -> Simple Lens (Map k v) (Maybe v)-valueAt k f m = go <$> f (Map.lookup k m) where-  go Nothing   = Map.delete k m-  go (Just v') = Map.insert k v' m-{-# INLINE valueAt #-}---- | This 'Lens' can be used to read, write or delete a member of an 'IntMap'.------ > ghci> IntMap.fromList [(1,"hello")]  ^. valueAtInt 1--- > Just "hello"------ > ghci> valueAtInt 2 +~ "goodbye" $ IntMap.fromList [(1,"hello")]--- > fromList [(1,"hello"),(2,"goodbye")]------ > valueAtInt :: Int -> (Maybe v -> f (Maybe v)) -> IntMap v -> f (IntMap v)-valueAtInt :: Int -> Simple Lens (IntMap v) (Maybe v)-valueAtInt k f m = go <$> f (IntMap.lookup k m) where-  go Nothing   = IntMap.delete k m-  go (Just v') = IntMap.insert k v' m-{-# INLINE valueAtInt #-}---- | This 'Lens' can be used to read, write or delete a member of a 'Set'------ > ghci> contains 3 +~ False $ Set.fromList [1,2,3,4]--- > fromList [1,2,4]------ > contains :: Ord k => k -> (Bool -> f Bool) -> Set k -> f (Set k)-contains :: Ord k => k -> Simple Lens (Set k) Bool-contains k f s = go <$> f (Set.member k s) where-  go False = Set.delete k s-  go True  = Set.insert k s-{-# INLINE contains #-}---- | This 'Lens' can be used to read, write or delete a member of an 'IntSet'------ > ghci> containsInt 3 +~ False $ IntSet.fromList [1,2,3,4]--- > fromList [1,2,4]------ > containsInt :: Int -> (Bool -> f Bool) -> IntSet -> f IntSet-containsInt :: Int -> Simple Lens IntSet Bool-containsInt k f s = go <$> f (IntSet.member k s) where-  go False = IntSet.delete k s-  go True  = IntSet.insert k s-{-# INLINE containsInt #-}- -- | This lens can be used to access the contents of the Identity monad identity :: Lens (Identity a) (Identity b) a b identity f (Identity a) = Identity <$> f a {-# INLINE identity #-} --- | This lens can be used to access the value of the nth bit in a number.------ @bitsAt n@ is only a legal 'Lens' into @b@ if @0 <= n < bitSize (undefined :: b)@-bitAt :: Bits b => Int -> Simple Lens b Bool-bitAt n f b = (\x -> if x then setBit b n else clearBit b n) <$> f (testBit b n)-{-# INLINE bitAt #-}- -- | This lens can be used to change the result of a function but only where -- the arguments match the key given. resultAt :: Eq e => e -> Simple Lens (e -> a) a@@ -863,30 +759,57 @@            | otherwise = a {-# INLINE resultAt #-} --- | Access the real part of a complex number+------------------------------------------------------------------------------+-- MonadWriter+------------------------------------------------------------------------------++-- | Tell a part of a value to a 'MonadWriter', filling in the rest from 'mempty' ----- > real :: Functor f => (a -> f a) -> Complex a -> f (Complex a)-real :: Simple Lens (Complex a) a-real f (a :+ b) = (:+ b) <$> f a+-- > whisper l d = tell (set l d mempty) --- | Access the imaginary part of a complex number+-- > whisper :: (MonadWriter b m, Monoid a) => Lens a b c d      -> d -> m ()+-- > whisper :: (MonadWriter b m, Monoid a) => Setter a b c d    -> d -> m ()+-- > whisper :: (MonadWriter b m, Monoid a) => Traversal a b c d -> d -> m () ----- > imaginary :: Functor f => (a -> f a) -> Complex a -> f (Complex a)-imaginary :: Simple Lens (Complex a) a-imaginary f (a :+ b) = (a :+) <$> f b+-- > whisper :: (MonadWriter b m, Monoid a) => ((c -> Identity d) -> a -> Identity b) -> d -> m ()+whisper :: (MonadWriter b m, Monoid a) => Setter a b c d -> d -> m ()+whisper l d = tell (set l d mempty)+{-# INLINE whisper #-} --- | 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!+------------------------------------------------------------------------------+-- MonadReader+------------------------------------------------------------------------------++-- |+-- Query the target of a 'Lens' or 'Getter' in the current state, or use a+-- summary of a 'Fold' or 'Traversal' that points to a monoidal value. ----- Otherwise, this is a perfectly convenient lens.+-- > query :: MonadReader a m             => Getter a b c d    -> m c+-- > query :: MonadReader a m             => Lens a b c d      -> m c+-- > query :: (MonadReader a m, Monoid c) => Fold a b c d      -> m c+-- > query :: (MonadReader a m, Monoid c) => Traversal a b c d -> m c ----- > polarize :: Functor f => ((a,a) -> f (a,a)) -> Complex a -> f (Complex a)-polarize :: RealFloat a => Simple Lens (Complex a) (a,a)-polarize f c = uncurry mkPolar <$> f (polar c)+-- > query :: MonadReader a m => ((c -> Const c d) -> a -> Const c b) -> m c+query :: MonadReader a m => Getting c a b c d -> m c+query l = Reader.asks (^.l)+{-# INLINE query #-} +-- |+-- Use the target of a 'Lens' 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 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) => Fold a b c d      -> (c -> e) -> m e+-- > queries :: (MonadReader a m, Monoid c) => Traversal a b c d -> (c -> e) -> m e+--+-- > queries :: MonadReader a m => ((c -> Const e d) -> a -> Const e b) -> (c -> e) -> m e+queries :: MonadReader a m => Getting e a b c d -> (c -> e) -> m e+queries l f = Reader.asks (views l f)+{-# INLINE queries #-}+ --------------------------------------------------------------------------------- State+-- MonadState ------------------------------------------------------------------------------  -- |@@ -900,7 +823,7 @@ -- -- > use :: MonadState a m => ((c -> Const c d) -> a -> Const c b) -> m c use :: MonadState a m => Getting c a b c d -> m c-use l = gets (^.l)+use l = State.gets (^.l) {-# INLINE use #-}  -- |@@ -914,21 +837,21 @@ -- -- > uses :: MonadState a m => ((c -> Const e d) -> a -> Const e b) -> (c -> e) -> m e uses :: MonadState a m => Getting e a b c d -> (c -> e) -> m e-uses l f = gets (views l f)+uses l f = State.gets (views l f) {-# INLINE uses #-} + -- | Replace the target of a 'Lens' or all of the targets of a 'Setter' or 'Traversal' in our monadic -- state with a new value, irrespective of the old. (^=) :: MonadState a m => Setter a a c d -> d -> m ()-l ^= b = modify (l ^~ b)+l ^= b = State.modify (l ^~ b) {-# INLINE (^=) #-}  -- | Map over the target of a 'Lens' or all of the targets of a 'Setter' or 'Traversal in our monadic state. (%=) :: MonadState a m => Setter a a c d -> (c -> d) -> m ()-l %= f = modify (l %~ f)+l %= f = State.modify (l %~ f) {-# INLINE (%=) #-} - -- | Modify the target(s) of a 'Simple' 'Lens', 'Setter' or 'Traversal' by adding a value -- -- Example:@@ -937,48 +860,41 @@ -- >   id += 1 -- >   access id (+=) :: (MonadState a m, Num b) => Simple Setter a b -> b -> m ()-l += b = modify (l +~ b)+l += b = State.modify (l +~ b) {-# INLINE (+=) #-}  -- | Modify the target(s) of a 'Simple' 'Lens', 'Setter' or 'Traversal' by subtracting a value (-=) :: (MonadState a m, Num b) => Simple Setter a b -> b -> m ()-l -= b = modify (l -~ b)+l -= b = State.modify (l -~ b) {-# INLINE (-=) #-}  -- | Modify the target(s) of a 'Simple' 'Lens', 'Setter' or 'Traversal' by multiplying by value (*=) :: (MonadState a m, Num b) => Simple Setter a b -> b -> m ()-l *= b = modify (l *~ b)+l *= b = State.modify (l *~ b) {-# INLINE (*=) #-}  -- | Modify the target(s) of a 'Simple' 'Lens', 'Setter' or 'Traversal' by dividing by a value (//=) ::  (MonadState a m, Fractional b) => Simple Setter a b -> b -> m ()-l //= b = modify (l //~ b)+l //= b = State.modify (l //~ b) {-# INLINE (//=) #-}  -- | Modify the target(s) of a 'Simple' 'Lens', 'Setter' or 'Traversal' by taking their logical '&&' with a value (&&=):: MonadState a m => Simple Setter a Bool -> Bool -> m ()-l &&= b = modify (l &&~ b)+l &&= b = State.modify (l &&~ b) {-# INLINE (&&=) #-}  -- | Modify the target(s) of a 'Simple' 'Lens', 'Setter' or 'Traversal' by taking their logical '||' with a value (||=) :: MonadState a m => Simple Setter a Bool -> Bool -> m ()-l ||= b = modify (l ||~ b)+l ||= b = State.modify (l ||~ b) {-# INLINE (||=) #-} --- | Modify the target(s) of a 'Simple' 'Lens', 'Setter' or 'Traversal' by computing its bitwise '.&.' with another value.-(&=):: (MonadState a m, Bits b) => Simple Setter a b -> b -> m ()-l &= b = modify (l &~ b)-{-# INLINE (&=) #-}---- | Modify the target(s) of a 'Simple' 'Lens', 'Setter' or 'Traversal' by computing its bitwise '.|.' with another value.-(|=) :: (MonadState a m, Bits b) => Simple Setter a b -> b -> m ()-l |= b = modify (l |~ b)-{-# INLINE (|=) #-}-+-- | Modify the target(s) of a 'Simple' 'Lens', 'Setter' or 'Traversal' by 'mappend'ing a value. (<>=) :: (MonadState a m, Monoid b) => Simple Setter a b -> b -> m ()-l <>= b = modify (l <>~ b)+l <>= b = State.modify (l <>~ b) {-# INLINE (<>=) #-} ++ -------------------------- -- Folds --------------------------@@ -1347,7 +1263,7 @@ lengthOf l = getSum . foldMapOf l (\_ -> Sum 1) {-# INLINE lengthOf #-} --- | Perform a safe 'head' of a 'Fold' or 'Traversal' or retrieve 'Just' the result +-- | Perform a safe 'head' of a 'Fold' or 'Traversal' or retrieve 'Just' the result -- from a 'Getter' or 'Lens'. -- -- > listToMaybe . toList = headOf folded@@ -1374,8 +1290,7 @@ -- | -- Returns 'True' if this 'Fold' or 'Traversal' has no targets in the given container. -------- Note: nullOf on a valid 'Lens' or 'Getter' will always return 'False'+-- Note: nullOf on a valid 'Lens' or 'Getter' should always return 'False' -- -- > null = nullOf folded --@@ -1459,12 +1374,16 @@ -- the leftmost element of the structure matching the predicate, or -- 'Nothing' if there is no such element. findOf :: Getting (First c) a b c d -> (c -> Bool) -> a -> Maybe c-findOf l p = getFirst . foldMapOf l (\c -> if p c then First (Just c) else First Nothing)+findOf l p = getFirst . foldMapOf l step where+  step c+    | p c       = First (Just c)+    | otherwise = First Nothing {-# INLINE findOf #-}  -- |--- A variant of 'foldrOf' that has no base case and thus may only be applied to lenses and structures --- such that the lens views at least one element of the structure.+-- A variant of 'foldrOf' that has no base case and thus may only be applied+-- to lenses and structures such that the lens views at least one element of+-- the structure. -- -- > foldr1Of l f = Prelude.foldr1 f . toListOf l --@@ -1475,7 +1394,8 @@ -- > foldr1Of :: Fold a b c d      -> (c -> c -> c) -> a -> c -- > foldr1Of :: Traversal a b c d -> (c -> c -> c) -> a -> c foldr1Of :: Getting (Endo (Maybe c)) a b c d -> (c -> c -> c) -> a -> c-foldr1Of l f xs = fromMaybe (error "foldr1Of: empty structure") (foldrOf l mf Nothing xs) where+foldr1Of l f xs = fromMaybe (error "foldr1Of: empty structure")+                            (foldrOf l mf Nothing xs) where   mf x Nothing = Just x   mf x (Just y) = Just (f x y) {-# INLINE foldr1Of #-}@@ -1523,7 +1443,8 @@   where f' x k z = k $! f z x {-# INLINE foldlOf' #-} --- | Monadic fold over the elements of a structure, associating to the right, i.e. from right to left.+-- | Monadic fold over the elements of a structure, associating to the right,+-- i.e. from right to left. -- -- > foldrM = foldrMOf folded --@@ -1531,12 +1452,15 @@ -- > foldrMOf :: Monad m => Lens a b c d      -> (c -> e -> m e) -> e -> a -> m e -- > foldrMOf :: Monad m => Fold a b c d      -> (c -> e -> m e) -> e -> a -> m e -- > foldrMOf :: Monad m => Traversal a b c d -> (c -> e -> m e) -> e -> a -> m e-foldrMOf :: Monad m => Getting (Dual (Endo (e -> m e))) a b c d -> (c -> e -> m e) -> e -> a -> m e+foldrMOf :: Monad m+         => Getting (Dual (Endo (e -> m e))) a b c d+         -> (c -> e -> m e) -> e -> a -> m e foldrMOf l f z0 xs = foldlOf l f' return xs z0   where f' k x z = f x z >>= k {-# INLINE foldrMOf #-} --- | Monadic fold over the elements of a structure, associating to the left, i.e. from left to right.+-- | Monadic fold over the elements of a structure, associating to the left,+-- i.e. from left to right. -- -- > foldlM = foldlMOf folded --@@ -1544,15 +1468,16 @@ -- > foldlMOf :: Monad m => Lens a b c d      -> (e -> c -> m e) -> e -> a -> m e -- > foldlMOf :: Monad m => Fold a b c d      -> (e -> c -> m e) -> e -> a -> m e -- > foldlMOf :: Monad m => Traversal a b c d -> (e -> c -> m e) -> e -> a -> m e-foldlMOf :: Monad m => Getting (Endo (e -> m e)) a b c d -> (e -> c -> m e) -> e -> a -> m e+foldlMOf :: Monad m+         => Getting (Endo (e -> m e)) a b c d+         -> (e -> c -> m e) -> e -> a -> m e foldlMOf l f z0 xs = foldrOf l f' return xs z0   where f' x k z = f z x >>= k {-# INLINE foldlMOf #-} ----------------------------+------------------------------------------------------------------------------ -- Traversals---------------------------+------------------------------------------------------------------------------  -- | This is the traversal that never succeeds at returning any values --@@ -1561,49 +1486,10 @@ traverseNothing = const pure {-# INLINE traverseNothing #-} --- The traversal for reading and writing to the head of a list------ > traverseHead = traverseValueAtMin--- > traverseHead = traverseElementAt 0 -- but is more efficient------ | > traverseHead :: Applicative f => (a -> f a) -> [a] -> f [a]-traverseHead :: Simple Traversal [a] a-traverseHead _ [] = pure []-traverseHead f (a:as) = (:as) <$> f a-{-# INLINE traverseHead #-}---- | Traversal for editing the tail of a list.------ > traverseTail :: Applicative f => ([a] -> f [a]) -> [a] -> f [a]-traverseTail :: Simple Traversal [a] [a]-traverseTail _ [] = pure []-traverseTail f (a:as) = (a:) <$> f as-{-# INLINE traverseTail #-}---- | Traverse the last element in a list.------ > traverseLast = traverseValueAtMax------ > traverseLast :: Applicative f => (a -> f a) -> [a] -> f [a]-traverseLast :: Simple Traversal [a] a-traverseLast _ []     = pure []-traverseLast f [a]    = return <$> f a-traverseLast f (a:as) = (a:) <$> traverseLast f as-{-# INLINE traverseLast #-}---- The traversal for reading and writing to the tail of a list---- | Traverse all but the last element of a list------ > traverseInit :: Applicative f => ([a] -> f [a]) -> [a] -> f [a]-traverseInit :: Simple Traversal [a] [a]-traverseInit _ [] = pure []-traverseInit f as = (++ [Prelude.last as]) <$> f (Prelude.init as)-{-# INLINE traverseInit #-}- -- | A traversal for tweaking the left-hand value in an Either: ----- > traverseLeft :: Applicative f => (a -> f b) -> Either a c -> f (Either b c)+-- > traverseLeft :: Applicative f+-- >              => (a -> f b) -> Either a c -> f (Either b c) traverseLeft :: Traversal (Either a c) (Either b c) a b traverseLeft f (Left a)  = Left <$> f a traverseLeft _ (Right c) = pure $ Right c@@ -1611,173 +1497,19 @@  -- | traverse the right-hand value in an Either: ----- > traverseRight :: Applicative f => (a -> f b) -> Either c a -> f (Either c a)+-- > traverseRight :: Applicative f+-- >               => (a -> f b) -> Either c a -> f (Either c a) -- > traverseRight = traverse ----- Unfortunately the instance for 'Traversable (Either c)' is still missing from--- base, so this can't just be 'traverse'+-- Unfortunately the instance for 'Traversable (Either c)' is still missing+-- from base, so this can't just be 'traverse' traverseRight :: Traversal (Either c a) (Either c b) a b traverseRight _ (Left c) = pure $ Left c traverseRight f (Right a) = Right <$> f a {-# INLINE traverseRight #-} --- | Traverse the value at a given key in a Map------ > traverseValueAt :: (Applicative f, Ord k) => k -> (v -> f v) -> Map k v -> f (Map k v)--- > traverseValueAt k = valueAt k . traverse-traverseValueAt :: Ord k => k -> Simple Traversal (Map k v) v-traverseValueAt k = valueAt k . traverse-{-# INLINE traverseValueAt #-}---- | Traverse the value at a given key in an IntMap------ > traverseValueAtInt :: Applicative f => Int -> (v -> f v) -> IntMap v -> f (IntMap v)--- > traverseValueAtInt k = valueAtInt k . traverse-traverseValueAtInt :: Int -> Simple Traversal (IntMap v) v-traverseValueAtInt k = valueAtInt k . traverse-{-# INLINE traverseValueAtInt #-}---- | Traverse a single element in a traversable container.------ > traverseElement :: (Applicative f, Traversable t) => Int -> (a -> f a) -> t a -> f (t a)-traverseElement :: Traversable t => Int -> Simple Traversal (t a) a-traverseElement = traverseElements . (==)-{-# INLINE traverseElement #-}---- | Traverse elements where a predicate holds on their position in a traversable container------ > traverseElements :: Applicative f, Traversable t) => (Int -> Bool) -> (a -> f a) -> t a -> f (t a)-traverseElements :: Traversable t => (Int -> Bool) -> Simple Traversal (t a) a-traverseElements p f ta = fst (runAppliedState (traverse go ta) 0) where-  go a = AppliedState $ \i -> (if p i then f a else pure a, i + 1)-{-# INLINE traverseElements #-}---- |--- Traverse the typed value contained in a 'Dynamic' where the type required by your function matches that--- of the contents of the 'Dynamic'.------ > traverseDynamic :: (Applicative f, Typeable a, Typeable b) => (a -> f b) -> Dynamic -> f Dynamic-traverseDynamic :: (Typeable a, Typeable b) => Traversal Dynamic Dynamic a b-traverseDynamic f dyn = case fromDynamic dyn of-  Just a  -> toDyn <$> f a-  Nothing -> pure dyn-{-# INLINE traverseDynamic #-}---- |--- 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 :: (Exception a, Exception b) => Traversal SomeException SomeException a b-traverseException f e = case fromException e of-  Just a -> toException <$> f a-  Nothing -> pure e-{-# INLINE traverseException #-}---- | Provides ad hoc overloading for 'traverseByteString'-class TraverseByteString t where-  -- | Traverse the individual bytes in a 'ByteString'-  ---  -- > anyOf traverseByteString (==0x80) :: TraverseByteString b => b -> Bool-  traverseByteString :: Simple Traversal t Word8--instance TraverseByteString Strict.ByteString where-  traverseByteString f = fmap Strict.pack . traverse f . Strict.unpack--instance TraverseByteString Lazy.ByteString where-  traverseByteString f = fmap Lazy.pack . traverse f . Lazy.unpack---- | Provides ad hoc overloading for 'traverseText'-class TraverseText t where-  -- | Traverse the individual characters in a 'Text'-  ---  -- > anyOf traverseText (=='c') :: TraverseText b => b -> Bool-  traverseText :: Simple Traversal t Char--instance TraverseText StrictText.Text where-  traverseText f = fmap StrictText.pack . traverse f . StrictText.unpack--instance TraverseText LazyText.Text where-  traverseText f = fmap LazyText.pack . traverse f . LazyText.unpack---- | Types that support traversal of the value of the minimal key------ This is separate from 'TraverseValueAtMax' because a min-heap--- or max-heap may be able to support one, but not the other.-class TraverseValueAtMin t where-  -- | Traverse the value for the minimal key-  traverseValueAtMin :: Simple Traversal (t v) v-  -- default traverseValueAtMin :: Traversable t => Traversal (t v) v-  -- traverseValueAtMin = traverseElement 0--instance TraverseValueAtMin (Map k) where-  traverseValueAtMin f m = case Map.minView m of-    Just (a, _) -> (\v -> Map.updateMin (const (Just v)) m) <$> f a-    Nothing     -> pure m--instance TraverseValueAtMin IntMap where-  traverseValueAtMin f m = case IntMap.minView m of-    Just (a, _) -> (\v -> IntMap.updateMin (const v) m) <$> f a-    Nothing     -> pure m--instance TraverseValueAtMin [] where-  traverseValueAtMin = traverseHead--instance TraverseValueAtMin Seq where-  traverseValueAtMin f m = case Seq.viewl m of-    a :< as -> (<| as) <$> f a-    EmptyL -> pure m--instance TraverseValueAtMin Tree where-  traverseValueAtMin f (Node a as) = (`Node` as) <$> f a---- | Types that support traversal of the value of the maximal key------ This is separate from 'TraverseValueAtMin' because a min-heap--- or max-heap may be able to support one, but not the other.-class TraverseValueAtMax t where-  -- | Traverse the value for the maximal key-  traverseValueAtMax :: Simple Traversal (t v) v--instance TraverseValueAtMax (Map k) where-  traverseValueAtMax f m = case Map.maxView m of-    Just (a, _) -> (\v -> Map.updateMax (const (Just v)) m) <$> f a-    Nothing     -> pure m--instance TraverseValueAtMax IntMap where-  traverseValueAtMax f m = case IntMap.maxView m of-    Just (a, _) -> (\v -> IntMap.updateMax (const v) m) <$> f a-    Nothing     -> pure m--instance TraverseValueAtMax [] where-  traverseValueAtMax = traverseLast--instance TraverseValueAtMax Seq where-  traverseValueAtMax f m = case Seq.viewr m of-    as :> a -> (as |>) <$> f a-    EmptyR  -> pure m---- | Traverse over all bits in a numeric type.------ > ghci> toListOf traverseBits (5 :: Word8)--- > [True,False,True,False,False,False,False,False]------ If you supply this an Integer, it won't crash, but the result will--- be an infinite traversal that can be productively consumed.------ > ghci> toListOf traverseBits 5--- > [True,False,True,False,False,False,False,False,False,False,False,False...-traverseBits :: Bits b => Simple Traversal b Bool-traverseBits f b = Prelude.foldr step 0 <$> traverse g bits-  where-    g n      = (,) n <$> f (testBit b n)-    bits     = Prelude.takeWhile hasBit [0..]-    hasBit n = complementBit b n /= b -- test to make sure that complementing this bit actually changes the value-    step (n,True) r = setBit r n-    step _        r = r-{-# INLINE traverseBits #-}---- | This provides a 'Traversal' that checks a predicate on a key before allowing you to traverse into a value.+-- | This provides a 'Traversal' that checks a predicate on a key before+-- allowing you to traverse into a value. traverseValue :: (k -> Bool) -> Simple Traversal (k, v) v traverseValue p f kv@(k,v)   | p k       = (,) k <$> f v@@ -1794,55 +1526,25 @@ -- -- Note: This only accepts a proper 'Lens', because 'IndexedStore' lacks its -- (admissable) Applicative instance.-clone :: Functor f => LensLike (IndexedStore c d) a b c d -> (c -> f d) -> a -> f b+clone :: Functor f+      => LensLike (IndexedStore c d) a b c d+      -> (c -> f d) -> a -> f b clone f cfd a = case f (IndexedStore id) a of   IndexedStore db c -> db <$> cfd c {-# INLINE clone #-} -------------------------------- Constructing Traversals--------------------------------- | Yields a 'Traversal' of the nth element of another 'Traversal'------ > traverseHead = elementOf traverse 0-elementOf :: Applicative f => LensLike (AppliedState f) a b c c -> Int -> LensLike f a b c c-elementOf l = elementsOf l . (==)-{-# INLINE elementOf #-}---- | A 'Traversal' of the elements in another 'Traversal' where their positions in that 'Traversal' satisfy a predicate------ > traverseTail = elementsOf traverse (>0)-elementsOf :: Applicative f => LensLike (AppliedState f) a b c c -> (Int -> Bool) -> LensLike f a b c c-elementsOf l p f ta = fst (runAppliedState (l go ta) 0) where-  go a = AppliedState $ \i -> (if p i then f a else pure a, i + 1)-{-# INLINE elementsOf #-}+------------------------------------------------------------------------------+-- Transforming Traversals+------------------------------------------------------------------------------ --- | This allows you to 'traverse' the elements of a 'Traversal' in the opposite order.+-- | This allows you to 'traverse' the elements of a 'Traversal' in the+-- opposite order. ----- Note: 'reversed' is similar, but is able to accept a 'Fold' (or 'Getter') and produce a 'Fold' (or 'Getter').+-- Note: 'reversed' is similar, but is able to accept a 'Fold' (or 'Getter')+-- and produce a 'Fold' (or 'Getter'). ----- This requires at least a 'Traversal' (or 'Lens') and can produce a 'Traversal' (or 'Lens') in turn.+-- This requires at least a 'Traversal' (or 'Lens') and can produce a+-- 'Traversal' (or 'Lens') in turn. backwards :: LensLike (Backwards f) a b c d -> LensLike f a b c d backwards l f = getBackwards . l (Backwards . f) {-# INLINE backwards #-}---- | Build a 'Traversal' that traverses the first @n@ elements of another 'Traversal'.------ > take n  = toListOf (taking n traverse)------ To 'take' from something that is merely a 'Fold', compose with @'folding' ('take' n)@ instead.-taking :: Applicative f => Int -> LensLike (AppliedState f) a b c c -> LensLike f a b c c-taking n l = elementsOf l (<n)-{-# INLINE taking #-}---- | Build a 'Traversal' that skips over the first @n@ elements of another 'Traversal', returning the rest.------ > drop n = toListOf (dropping n traverse)------ To 'drop' from something that is merely a 'Fold', compose with @'folding' ('drop' n)@ instead.-dropping :: Applicative f => Int -> LensLike (AppliedState f) a b c c -> LensLike f a b c c-dropping n l = elementsOf l (>=n)-{-# INLINE dropping #-}
+ src/Control/Parallel/Strategies/Lens.hs view
@@ -0,0 +1,48 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Parallel.Strategies.Lens+-- Copyright   :  (C) 2012 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+-- A 'Lens' or 'Traversal' can be used to take the role of 'Traversable' in+-- @Control.Parallel.Strategies@, enabling those combinators to work with+-- monomorphic containers.+----------------------------------------------------------------------------+module Control.Parallel.Strategies.Lens+  ( evalTraversal+  , parTraversal+  ) where++import Control.Lens+import Control.Parallel.Strategies++-- | 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+--+-- > evalTraversal :: (b -> Eval b) -> a -> Eval a) -> Strategy b -> Strategy a+evalTraversal :: LensLike Eval a a b b -> Strategy b -> Strategy a+evalTraversal 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 l s = l (rparWith s)+--+-- > 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+parTraversal :: LensLike Eval a a b b -> Strategy b -> Strategy a+parTraversal l s = l (rparWith s)
+ src/Data/Array/Lens.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE LiberalTypeSynonyms #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Array.Lens+-- Copyright   :  (C) 2012 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  MPTCs, Rank2Types, LiberalTypeSynonyms+--+----------------------------------------------------------------------------+module Data.Array.Lens+  (+  -- * Indexing+    ix+  -- * Setters+  , amapped+  , ixmapped+  -- * Traversal+  , traverseArray+  ) where++import Control.Applicative+import Control.Lens+import Data.Array.IArray++-- | Access an element of an array.+--+-- Note: The indexed element is assumed to exist in the target array.+--+-- > arr ! i = arr^.ix i+-- > arr // [(i,e)] = ix i ^= e $ arr+--+-- > ghci> ix 2 ^= 9 $ listArray (1,5) [4,5,6,7,8]+-- > array (1,5) [4,9,6,7,8]+ix :: (IArray a e, Ix i) => i -> Simple Lens (a i e) e+ix i f arr = (\e -> arr // [(i,e)]) <$> f (arr ! i)+{-# INLINE ix #-}++-- | This setter can be used to map over all of the values in an array.+--+-- Note: 'traverseArray' is strictly more general and permits more operations+--+-- > amap = adjust amapped+-- > amapped = sets amap+amapped :: (IArray a c, IArray a d, Ix i) => Setter (a i c) (a i d) c d+amapped = sets amap+{-# INLINE amapped #-}++-- | This setter can be used to derive a new array from an old array by+-- applying a function to each of the indices.+--+-- > ixmap = adjust . ixmapped+-- > ixmapped = sets . ixmap+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 'Traversal' of the elements of an array.+--+-- > amap = adjust traverseArray+traverseArray :: (IArray a c, IArray a d, Ix i) => Traversal (a i c) (a i d) c d+traverseArray f arr = array (bounds arr) <$> (traverse._2) f (assocs arr)+{-# INLINE traverseArray #-}
+ src/Data/Bits/Lens.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE LiberalTypeSynonyms #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Bits.Lens+-- Copyright   :  (C) 2012 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  LiberalTypeSynonyms+--+----------------------------------------------------------------------------+module Data.Bits.Lens+  ( (|~), (&~)+  , (|=), (&=)+  , bitAt+  , traverseBits+  ) where++import Control.Lens+import Control.Monad.State.Class+import Data.Bits+import Data.Functor++infixr 4 |~, &~+infix 4 |=, &=++-- | Bitwise '.|.' the target(s) of a 'Bool'-valued 'Lens' or 'Setter'+(|~):: Bits c => Setter a b c c -> c -> a -> b+l |~ n = adjust l (.|. n)+{-# INLINE (|~) #-}++-- | Bitwise '.&.' the target(s) of a 'Bool'-valued 'Lens' or 'Setter'+(&~) :: Bits c => Setter a b c c -> c -> a -> b+l &~ n = adjust l (.&. n)+{-# INLINE (&~) #-}++-- | Modify the target(s) of a 'Simple' 'Lens', 'Setter' or 'Traversal' by computing its bitwise '.&.' with another value.+(&=):: (MonadState a m, Bits b) => Simple Setter a b -> b -> m ()+l &= b = modify (l &~ b)+{-# INLINE (&=) #-}++-- | Modify the target(s) of a 'Simple' 'Lens', 'Setter' or 'Traversal' by computing its bitwise '.|.' with another value.+(|=) :: (MonadState a m, Bits b) => Simple Setter a b -> b -> m ()+l |= b = modify (l |~ b)+{-# INLINE (|=) #-}++-- | This lens can be used to access the value of the nth bit in a number.+--+-- @bitsAt n@ is only a legal 'Lens' into @b@ if @0 <= n < bitSize (undefined :: b)@+bitAt :: Bits b => Int -> Simple Lens b Bool+bitAt n f b = (\x -> if x then setBit b n else clearBit b n) <$> f (testBit b n)+{-# INLINE bitAt #-}++-- | Traverse over all bits in a numeric type.+--+-- > ghci> toListOf traverseBits (5 :: Word8)+-- > [True,False,True,False,False,False,False,False]+--+-- If you supply this an Integer, it won't crash, but the result will+-- be an infinite traversal that can be productively consumed.+--+-- > ghci> toListOf traverseBits 5+-- > [True,False,True,False,False,False,False,False,False,False,False,False...+traverseBits :: Bits b => Simple Traversal b Bool+traverseBits f b = Prelude.foldr step 0 <$> traverse g bits+  where+    g n      = (,) n <$> f (testBit b n)+    bits     = Prelude.takeWhile hasBit [0..]+    hasBit n = complementBit b n /= b -- test to make sure that complementing this bit actually changes the value+    step (n,True) r = setBit r n+    step _        r = r+{-# INLINE traverseBits #-}
+ src/Data/ByteString/Lens.hs view
@@ -0,0 +1,31 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.ByteString.Lens+-- Copyright   :  (C) 2012 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+----------------------------------------------------------------------------+module Data.ByteString.Lens+  ( TraverseByteString(..)+  ) where++import Control.Lens+import Data.ByteString as Strict+import Data.ByteString.Lazy as Lazy+import Data.Word (Word8)++-- | Provides ad hoc overloading for 'traverseByteString'+class TraverseByteString t where+  -- | Traverse the individual bytes in a 'ByteString'+  --+  -- > anyOf traverseByteString (==0x80) :: TraverseByteString b => b -> Bool+  traverseByteString :: Simple Traversal t Word8++instance TraverseByteString Strict.ByteString where+  traverseByteString f = fmap Strict.pack . traverse f . Strict.unpack++instance TraverseByteString Lazy.ByteString where+  traverseByteString f = fmap Lazy.pack . traverse f . Lazy.unpack
+ src/Data/Complex/Lens.hs view
@@ -0,0 +1,46 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Complex.Lens+-- Copyright   :  (C) 2012 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  Haskell2010+--+----------------------------------------------------------------------------+module Data.Complex.Lens+  ( real, imaginary, polarize+  , traverseComplex+  ) where++import Control.Applicative+import Control.Lens+import Data.Complex++-- | Access the real part of a complex number+--+-- > real :: Functor f => (a -> f a) -> Complex a -> f (Complex a)+real :: Simple Lens (Complex a) a+real f (a :+ b) = (:+ b) <$> f a++-- | Access the imaginary part of a complex number+--+-- > imaginary :: Functor f => (a -> f a) -> Complex a -> f (Complex a)+imaginary :: Simple Lens (Complex a) a+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.+--+-- > polarize :: (RealFloat a, RealFloat b, Functor f)+-- >           => ((a,a) -> f (b,b)) -> Complex a -> f (Complex b)+polarize :: (RealFloat a, RealFloat b) => Lens (Complex a) (Complex b) (a,a) (b,b)+polarize f c = uncurry mkPolar <$> f (polar c)++-- | Traverse both the real and imaginary parts of a complex number.+--+-- > traverseComplex :: Applicative f => (a -> f b) -> Complex a -> f (Complex b)+traverseComplex :: Traversal (Complex a) (Complex b) a b+traverseComplex f (a :+ b) = (:+) <$> f a <*> f b
+ src/Data/Dynamic/Lens.hs view
@@ -0,0 +1,28 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Dynamic.Lens+-- Copyright   :  (C) 2012 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+----------------------------------------------------------------------------+module Data.Dynamic.Lens+  ( traverseDynamic+  ) where++import Control.Applicative+import Control.Lens+import Data.Dynamic++-- |+-- Traverse the typed value contained in a 'Dynamic' where the type required by your function matches that+-- of the contents of the 'Dynamic'.+--+-- > traverseDynamic :: (Applicative f, Typeable a, Typeable b) => (a -> f b) -> Dynamic -> f Dynamic+traverseDynamic :: (Typeable a, Typeable b) => Traversal Dynamic Dynamic a b+traverseDynamic f dyn = case fromDynamic dyn of+  Just a  -> toDyn <$> f a+  Nothing -> pure dyn+{-# INLINE traverseDynamic #-}
+ src/Data/IntMap/Lens.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE LiberalTypeSynonyms #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.IntMap.Lens+-- Copyright   :  (C) 2012 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  Rank2Types+--+----------------------------------------------------------------------------+module Data.IntMap.Lens+  ( at+  , traverseAt+  , traverseAtMin+  , traverseAtMax+  ) where++import Control.Applicative as Applicative+import Control.Lens+import Data.IntMap as IntMap++-- | This 'Lens' can be used to read, write or delete the value associated with a key in an 'IntMap'.+--+-- > ghci> fromList [(1,"hello")] ^.at 1+-- > Just "hello"+--+-- > ghci> at 1 ^~ Just "hello" $ mempty+-- > 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+{-# INLINE at #-}++-- | Traverse the value at a given key in an IntMap+--+-- > traverseAt :: Applicative f => Int -> (v -> f v) -> IntMap v -> f (IntMap v)+-- > traverseAt k = at k . traverse+traverseAt :: Int -> Simple Traversal (IntMap v) v+traverseAt k = at k . traverse+{-# INLINE traverseAt #-}++-- | Traverse the value at the minimum key in a Map+traverseAtMin :: Simple Traversal (IntMap v) v+traverseAtMin f m = case IntMap.minView m of+  Just (a, _) -> (\v -> IntMap.updateMin (const v) m) <$> f a+  Nothing     -> pure m+{-# INLINE traverseAtMin #-}++-- | Traverse the value at the maximum key in a Map+traverseAtMax :: Simple Traversal (IntMap v) v+traverseAtMax f m = case IntMap.maxView m of+    Just (a, _) -> (\v -> IntMap.updateMax (const v) m) <$> f a+    Nothing     -> pure m+{-# INLINE traverseAtMax #-}
+ src/Data/IntSet/Lens.hs view
@@ -0,0 +1,29 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.IntSet.Lens+-- Copyright   :  (C) 2012 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+----------------------------------------------------------------------------+module Data.IntSet.Lens+  ( contains+  ) where++import Control.Lens+import Data.Functor+import Data.IntSet as IntSet++-- | This 'Lens' can be used to read, write or delete a member of an 'IntSet'+--+-- > ghci> contains 3 +~ False $ fromList [1,2,3,4]+-- > fromList [1,2,4]+--+-- > contains :: Int -> (Bool -> f Bool) -> IntSet -> f IntSet+contains :: Int -> Simple Lens IntSet Bool+contains k f s = go <$> f (IntSet.member k s) where+  go False = IntSet.delete k s+  go True  = IntSet.insert k s+{-# INLINE contains #-}
+ src/Data/Map/Lens.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE LiberalTypeSynonyms #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Map.Lens+-- Copyright   :  (C) 2012 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  Rank2Types+--+----------------------------------------------------------------------------+module Data.Map.Lens+  ( at+  , traverseAt+  , traverseAtMin+  , traverseAtMax+  ) where++import Control.Applicative as Applicative+import Control.Lens+import Data.Map as Map++-- | This 'Lens' can be used to read, write or delete the value associated with a key in a 'Map'.+--+-- > ghci> Map.fromList [("hello",12)] ^.at "hello"+-- > Just 12+--+-- > 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+{-# INLINE at #-}++-- | Traverse the value at a given key in a Map+--+-- > traverseAt :: (Applicative f, Ord k) => k -> (v -> f v) -> Map k v -> f (Map k v)+-- > traverseAt k = valueAt k . traverse+traverseAt :: Ord k => k -> SimpleTraversal (Map k v) v+traverseAt k = at k . traverse+{-# INLINE traverseAt #-}++-- | Traverse the value at the minimum key in a Map+traverseAtMin :: SimpleTraversal (Map k v) v+traverseAtMin f m = case Map.minView m of+  Just (a, _) -> (\v -> Map.updateMin (const (Just v)) m) <$> f a+  Nothing     -> pure m+{-# INLINE traverseAtMin #-}++-- | Traverse the value at the maximum key in a Map+traverseAtMax :: SimpleTraversal (Map k v) v+traverseAtMax f m = case Map.maxView m of+    Just (a, _) -> (\v -> Map.updateMax (const (Just v)) m) <$> f a+    Nothing     -> pure m+{-# INLINE traverseAtMax #-}
+ src/Data/Sequence/Lens.hs view
@@ -0,0 +1,98 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Sequence.Lens+-- Copyright   :  (C) 2012 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+----------------------------------------------------------------------------+module Data.Sequence.Lens+  ( at, viewL, viewR+  , traverseHead, traverseTail+  , traverseLast, traverseInit+  , traverseTo, traverseFrom+  , traverseSlice+  ) where++import Control.Applicative+import Control.Lens+import Data.Monoid+import Data.Sequence as Seq++-- | A 'Lens' that can access the @n@th element of a 'Seq'.+--+-- Note: This is only a legal lens if there is such an element!+--+at :: Int -> Simple Lens (Seq a) a+at i f m = (\a -> update i a m) <$> f (index m i)++-- * Sequence isomorphisms++-- | A 'Seq' is isomorphic to a 'ViewL'+--+-- > viewl m = m^.viewL+viewL :: Simple Lens (Seq a) (ViewL a)+viewL f m = go <$> f (viewl m) where+  go EmptyL = mempty+  go (a :< as) = a <| as+{-# INLINE viewL #-}++-- | A 'Seq' is isomorphic to a 'ViewR'+--+-- > viewr m = m^.viewR+viewR :: Simple Lens (Seq a) (ViewR a)+viewR f m = go <$> f (viewr m) where+  go EmptyR = mempty+  go (as :> a) = as |> a+{-# INLINE viewR #-}++-- * Traversals++-- | Traverse the head of a 'Seq'+traverseHead :: Simple Traversal (Seq a) a+traverseHead f m = case viewl m of+  a :< as -> (<| as) <$> f a+  EmptyL  -> pure m+{-# INLINE traverseHead #-}++-- | Traverse the tail of a 'Seq'+traverseTail :: Simple Traversal (Seq a) a+traverseTail f m = case viewl m of+  a :< as -> (a <|) <$> traverse f as+  EmptyL  -> pure m+{-# INLINE traverseTail #-}++-- | Traverse the last element of a 'Seq'+traverseLast :: Simple Traversal (Seq a) a+traverseLast f m = case viewr m of+  as :> a -> (as |>) <$> f a+  EmptyR  -> pure m+{-# INLINE traverseLast #-}++-- | Traverse all but the last element of a 'Seq'+traverseInit :: Simple Traversal (Seq a) a+traverseInit f m = case viewr m of+  as :> a -> (|> a) <$> traverse f as+  EmptyR  -> pure m+{-# INLINE traverseInit #-}++-- | Traverse the first @n@ elements of a 'Seq'+traverseTo :: Int -> Simple Traversal (Seq a) a+traverseTo n f m = case Seq.splitAt n m of+  (l,r) -> (>< r) <$> traverse f l+{-# INLINE traverseTo #-}++-- | Traverse all but the first @n@ elements of a 'Seq'+traverseFrom :: Int -> Simple Traversal (Seq a) a+traverseFrom n f m = case Seq.splitAt n m of+  (l,r) -> (l ><) <$> traverse f r+{-# INLINE traverseFrom #-}++-- | Travere all the elements numbered from @i@ to @j@ of a 'Seq'+traverseSlice :: Int -> Int -> Simple Traversal (Seq a) a+traverseSlice i j f s = case Seq.splitAt i s of+  (l,mr) -> case Seq.splitAt (j-i) mr of+     (m, r) -> (\n -> l >< n >< r) <$> traverse f m+{-# INLINE traverseSlice #-}
+ src/Data/Set/Lens.hs view
@@ -0,0 +1,29 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Set.Lens+-- Copyright   :  (C) 2012 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+----------------------------------------------------------------------------+module Data.Set.Lens+  ( contains+  ) where++import Control.Lens+import Data.Set as Set+import Data.Functor++-- | This 'Lens' can be used to read, write or delete a member of a 'Set'+--+-- > ghci> contains 3 +~ False $ Set.fromList [1,2,3,4]+-- > fromList [1,2,4]+--+-- > contains :: Ord k => k -> (Bool -> f Bool) -> Set k -> f (Set k)+contains :: Ord k => k -> Simple Lens (Set k) Bool+contains k f s = go <$> f (Set.member k s) where+  go False = Set.delete k s+  go True  = Set.insert k s+{-# INLINE contains #-}
+ src/Data/Text/Lens.hs view
@@ -0,0 +1,30 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Text.Lens+-- Copyright   :  (C) 2012 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+----------------------------------------------------------------------------+module Data.Text.Lens+  ( TraverseText(..)+  ) where++import Control.Lens+import Data.Text as Strict+import Data.Text.Lazy as Lazy++-- | Provides ad hoc overloading for 'traverseText' for both strict and lazy 'Text'.+class TraverseText t where+  -- | Traverse the individual characters in a either strict or lazy 'Text'.+  --+  -- > anyOf traverseText (=='c') :: TraverseText b => b -> Bool+  traverseText :: Simple Traversal t Char++instance TraverseText Strict.Text where+  traverseText f = fmap Strict.pack . traverse f . Strict.unpack++instance TraverseText Lazy.Text where+  traverseText f = fmap Lazy.pack . traverse f . Lazy.unpack
+ src/Data/Tree/Lens.hs view
@@ -0,0 +1,27 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Tree.Lens+-- Copyright   :  (C) 2012 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+----------------------------------------------------------------------------++module Data.Tree.Lens+  ( root+  , children+  ) where++import Control.Lens+import Data.Functor+import Data.Tree++-- | A 'Lens' that focuses on the root of a 'Tree'.+root :: Simple Lens (Tree a) a+root f (Node a as) = (`Node` as) <$> f a++-- | A 'Traversal' of the direct descendants of the root of a 'Tree'.+children :: Simple Traversal (Tree a) (Tree a)+children f (Node a as) = Node a <$> traverse f as