packages feed

lens 3.7.0.2 → 3.7.1

raw patch · 23 files changed

+499/−89 lines, 23 filesdep +test-framework-quickcheck2dep ~basedep ~hashable

Dependencies added: test-framework-quickcheck2

Dependency ranges changed: base, hashable

Files

CHANGELOG.markdown view
@@ -1,3 +1,13 @@+3.7.1+-----+* Added `preuse`, `preuses` to `Control.Lens.Fold`+* Added `Each(each)` to `Control.Lens.Each` for indexed traversal of potentially monomorphic containers.+* Added `indexing64` and `traversed64` for help with large containers.+* Generalized the type signature of `choosing`.+* Exported `unwrapped` from `Control.Lens.Wrapped`.+* Support for `hashable` 1.2+* Added `(??)` to `Control.Lens.Combinators`.+ 3.7.0.2 ------- * Fixed flagging for Safe Haskell.
README.markdown view
@@ -264,7 +264,7 @@   <td/>   <td><a href="http://ekmett.github.com/lens/Control-Lens-Type.html#v:-37--37--61-"><code>%%=</code></a></td>   <td/>-  <td>Update target(s) with an <code>Applicative</code> or auxillary result</td>+  <td>Update target(s) with an <code>Applicative</code> or auxiliary result</td> </tr> <tr>   <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:-43--126-"><code>+~</code></a></td>@@ -366,7 +366,7 @@   <td/>   <td><a href="http://ekmett.github.com/lens/Control-Lens-IndexedLens.html#v:-37--37--64--61-"><code>%%@=</code></a></td>   <td/>-  <td>Update target(s) with an <code>Applicative</code> or auxillary result with access to the index.</td>+  <td>Update target(s) with an <code>Applicative</code> or auxiliary result with access to the index.</td> </tr> <tr><th colspan=5><a href="http://ekmett.github.com/lens/Data-Bits-Lens.html">Data.Bits.Lens</a></th></tr> <tr>
examples/Pong.hs view
@@ -22,7 +22,7 @@ import Graphics.Gloss import Graphics.Gloss.Interface.Pure.Game -import System.Random (randomRs, getStdGen)+import System.Random (randomRs, newStdGen)  -- Some global constants @@ -224,7 +224,7 @@  startingSpeeds :: IO [Vector] startingSpeeds = do-  rs <- randomRs (-initialSpeed, initialSpeed) <$> getStdGen+  rs <- randomRs (-initialSpeed, initialSpeed) <$> newStdGen   return . interleave $ filter ((> 0.2) . abs) rs    where
lens.cabal view
@@ -1,6 +1,6 @@ name:          lens category:      Data, Lenses-version:       3.7.0.2+version:       3.7.1 license:       BSD3 cabal-version: >= 1.8 license-file:  LICENSE@@ -111,7 +111,7 @@  -- Enable template haskell. Disable this at your own risk and for testing only. ----- cabal configure -f-template-haskell is an /unsuppported/ configuration.+-- cabal configure -f-template-haskell is an /unsupported/ configuration. -- -- Clients of this library can and should expect this to be turned on. flag template-haskell@@ -169,7 +169,7 @@     comonad-transformers == 3.0.*,     comonads-fd          == 3.0.*,     containers           >= 0.4.0    && < 0.6,-    hashable             >= 1.1.2.3  && < 1.2,+    hashable             >= 1.1.2.3  && < 1.3,     mtl                  >= 2.0.1    && < 2.2,     semigroups           >= 0.8.4    && < 0.9,     split                == 0.2.*,@@ -193,6 +193,7 @@     Control.Lens.Action     Control.Lens.Classes     Control.Lens.Combinators+    Control.Lens.Each     Control.Lens.Fold     Control.Lens.Getter     Control.Lens.Indexed@@ -302,32 +303,37 @@ test-suite properties   type: exitcode-stdio-1.0   main-is: properties.hs-  build-depends:-    base,-    lens,-    QuickCheck   >= 2.4 && < 2.6,-    transformers-  ghc-options: -w -threaded+  ghc-options: -w -threaded -rtsopts -with-rtsopts=-N   hs-source-dirs: tests   if !flag(test-properties)     buildable: False+  else+    build-depends:+      base,+      lens,+      QuickCheck                 >= 2.4 && < 2.6,+      test-framework             >= 0.6 && < 0.9,+      test-framework-quickcheck2 >= 0.2 && < 0.4,+      test-framework-th          >= 0.2 && < 0.4,+      transformers  test-suite hunit   type: exitcode-stdio-1.0   main-is: hunit.hs-  build-depends:-    base,-    containers,-    HUnit == 1.2.*,-    lens,-    mtl,-    test-framework       >= 0.6 && < 0.9,-    test-framework-hunit >= 0.2 && < 0.4,-    test-framework-th    >= 0.2 && < 0.4-  ghc-options: -w -threaded+  ghc-options: -w -threaded -rtsopts -with-rtsopts=-N   hs-source-dirs: tests   if !flag(test-hunit)     buildable: False+  else+    build-depends:+      base,+      containers,+      HUnit == 1.2.*,+      lens,+      mtl,+      test-framework       >= 0.6 && < 0.9,+      test-framework-hunit >= 0.2 && < 0.4,+      test-framework-th    >= 0.2 && < 0.4  -- Verify the results of the examples test-suite doctests
src/Control/Lens.hs view
@@ -46,6 +46,7 @@ module Control.Lens   ( module Control.Lens.Action   , module Control.Lens.Combinators+  , module Control.Lens.Each   , module Control.Lens.Fold   , module Control.Lens.Getter   , module Control.Lens.Indexed@@ -74,6 +75,7 @@  import Control.Lens.Action import Control.Lens.Combinators+import Control.Lens.Each import Control.Lens.Fold import Control.Lens.Getter import Control.Lens.Indexed
src/Control/Lens/Classes.hs view
@@ -94,9 +94,9 @@ -- Programming with Effects ------------------------------------------------------------------------------- --- | An 'Effective' 'Functor' ignores its argument and is isomorphic to a monad wrapped around a value.+-- | 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.+-- 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 :: m r -> f a   ineffective :: f a -> m r@@ -148,10 +148,10 @@   -- | Build a simple isomorphism from a pair of inverse functions   --   -- @-  -- 'view' ('iso' f g) ≡ f-  -- 'view' ('from' ('iso' f g)) ≡ g-  -- 'set' ('iso' f g) h ≡ g '.' h '.' f-  -- 'set' ('from' ('iso' f g)) h ≡ f '.' h '.' g+  -- 'Control.Lens.Getter.view' ('iso' f g) ≡ f+  -- 'Control.Lens.Getter.view' ('Control.Lens.Iso.from' ('iso' f g)) ≡ g+  -- 'Control.Lens.Setter.set' ('iso' f g) h ≡ g '.' h '.' f+  -- 'Control.Lens.Setter.set' ('Control.Lens.Iso.from' ('iso' f g)) h ≡ f '.' h '.' g   -- @   iso :: Functor f => (s -> a) -> (b -> t) -> k (a -> f b) (s -> f t)
src/Control/Lens/Combinators.hs view
@@ -9,13 +9,16 @@ -- ------------------------------------------------------------------------------- module Control.Lens.Combinators-  ( (<$!>), (<$!), (<&>)+  ( (<$!>), (<$!), (<&>), (??)   ) where  import Data.Functor ((<$>)) +-- $setup+-- >>> import Control.Lens+ infixl 4 <$!>, <$!-infixl 1 <&>+infixl 1 <&>, ??  -- | A strict version of ('Data.Functor.<$>') for monads. --@@ -43,3 +46,14 @@ (<&>) :: Functor f => f a -> (a -> b) -> f b as <&> f = f <$> as {-# INLINE (<&>) #-}++-- | This is convenient to 'flip' argument order of composite functions+--+-- >>> over _2 ?? ("hello","world") $ length+-- ("hello",5)+--+-- >>> over ?? length ?? ("hello","world") $ _2+-- ("hello",5)+(??) :: Functor f => f (a -> b) -> a -> f b+fab ?? a = fmap ($ a) fab+{-# INLINE (??) #-}
+ src/Control/Lens/Each.hs view
@@ -0,0 +1,174 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+#ifndef MIN_VERSION_base+#define MIN_VERSION_base(x,y,z) 1+#endif+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Lens.Each+-- Copyright   :  (C) 2012 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  non-portable+--+-----------------------------------------------------------------------------+module Control.Lens.Each+  ( Each(..)+  ) where++import Control.Applicative+import Control.Lens.Indexed as Lens+import Control.Lens.IndexedTraversal+import Control.Lens.Traversal+import Control.Lens.Iso+import Data.ByteString as StrictB+import Data.ByteString.Lazy as LazyB+import Data.Complex+import Data.Functor.Identity+import Data.Int+import Data.Sequence as Seq+import Data.Text as StrictT+import Data.Text.Lazy as LazyT+import Data.Traversable+import Data.Tree as Tree+import Data.Word+import Data.Map as Map+import Data.IntMap as IntMap+import Data.HashMap.Lazy as HashMap+import Data.Vector as Vector+import Data.Vector.Primitive as Prim+import Data.Vector.Storable as Storable+import Data.Vector.Unboxed as Unboxed+import Data.Array.Unboxed as Unboxed+import Data.Array.IArray as IArray++-- $setup+-- >>> import Control.Lens+-- >>> import Data.Text.Strict.Lens as Text+-- >>> import Data.Char as Char++-- | Extract 'each' element of a (potentially monomorphic) container.+--+-- Notably, when applied to a tuple, this generalizes 'Control.Lens.Traversal.both' to arbitrary homogeneous tuples.+--+-- >>> (1,2,3) & each *~ 10+-- (10,20,30)+--+-- It can also be used on monomorphic containers like 'StrictT.Text' or 'StrictB.ByteString'+--+-- >>> over each Char.toUpper ("hello"^.Text.packed)+-- "HELLO"+--+-- 'each' is an indexed traversal, so it can be used to access keys in many containers:+--+-- >>> itoListOf each $ Map.fromList [("hello",2),("world",4)]+-- [("hello",2),("world",4)]+--+-- >>> ("hello","world") & each.each %~ Char.toUpper+-- ("HELLO","WORLD")+class Each i s t a b | s -> i a, t -> i b, s b -> t, t a -> s where+  each :: IndexedTraversal i s t a b+  default each :: (Traversable f, s ~ f a, t ~ f b) => IndexedTraversal Int s t a b+  each = traversed+  {-# INLINE each #-}++instance (a ~ a', b ~ b') => Each Int (a,a') (b,b') a b where+  each = Lens.indexed $ \ f ~(a,b) -> (,) <$> f (0 :: Int) a <*> f 1 b+  {-# INLINE each #-}++instance (a ~ a2, a ~ a3, b ~ b2, b ~ b3) => Each Int (a,a2,a3) (b,b2,b3) a b where+  each = Lens.indexed $ \ f ~(a,b,c) -> (,,) <$> f (0 :: Int) a <*> f 1 b <*> f 2 c+  {-# INLINE each #-}++instance (a ~ a2, a ~ a3, a ~ a4, b ~ b2, b ~ b3, b ~ b4) => Each Int (a,a2,a3,a4) (b,b2,b3,b4) a b where+  each = Lens.indexed $ \ f ~(a,b,c,d) -> (,,,) <$> f (0 :: Int) a <*> f 1 b <*> f 2 c <*> f 3 d+  {-# INLINE each #-}++instance (a ~ a2, a ~ a3, a ~ a4, a ~ a5, b ~ b2, b ~ b3, b ~ b4, b ~ b5) => Each Int (a,a2,a3,a4,a5) (b,b2,b3,b4,b5) a b where+  each = Lens.indexed $ \ f ~(a,b,c,d,e) -> (,,,,) <$> f (0 :: Int) a <*> f 1 b <*> f 2 c <*> f 3 d <*> f 4 e+  {-# INLINE each #-}++instance (a ~ a2, a ~ a3, a ~ a4, a ~ a5, a ~ a6, b ~ b2, b ~ b3, b ~ b4, b ~ b5, b ~ b6) => Each Int (a,a2,a3,a4,a5,a6) (b,b2,b3,b4,b5,b6) a b where+  each = Lens.indexed $ \ f ~(a,b,c,d,e,g) -> (,,,,,) <$> f (0 :: Int) a <*> f 1 b <*> f 2 c <*> f 3 d <*> f 4 e <*> f 5 g+  {-# INLINE each #-}++instance (a ~ a2, a ~ a3, a ~ a4, a ~ a5, a ~ a6, a ~ a7, b ~ b2, b ~ b3, b ~ b4, b ~ b5, b ~ b6, b ~ b7) => Each Int (a,a2,a3,a4,a5,a6,a7) (b,b2,b3,b4,b5,b6,b7) a b where+  each = Lens.indexed $ \ f ~(a,b,c,d,e,g,h) -> (,,,,,,) <$> f (0 :: Int) a <*> f 1 b <*> f 2 c <*> f 3 d <*> f 4 e <*> f 5 g <*> f 6 h+  {-# INLINE each #-}++instance (a ~ a2, a ~ a3, a ~ a4, a ~ a5, a ~ a6, a ~ a7, a ~ a8, b ~ b2, b ~ b3, b ~ b4, b ~ b5, b ~ b6, b ~ b7, b ~ b8) => Each Int (a,a2,a3,a4,a5,a6,a7,a8) (b,b2,b3,b4,b5,b6,b7,b8) a b where+  each = Lens.indexed $ \ f ~(a,b,c,d,e,g,h,i) -> (,,,,,,,) <$> f (0 :: Int) a <*> f 1 b <*> f 2 c <*> f 3 d <*> f 4 e <*> f 5 g <*> f 6 h <*> f 7 i+  {-# INLINE each #-}++instance (a ~ a2, a ~ a3, a ~ a4, a ~ a5, a ~ a6, a ~ a7, a ~ a8, a ~ a9, b ~ b2, b ~ b3, b ~ b4, b ~ b5, b ~ b6, b ~ b7, b ~ b8, b ~ b9) => Each Int (a,a2,a3,a4,a5,a6,a7,a8,a9) (b,b2,b3,b4,b5,b6,b7,b8,b9) a b where+  each = Lens.indexed $ \ f ~(a,b,c,d,e,g,h,i,j) -> (,,,,,,,,) <$> f (0 :: Int) a <*> f 1 b <*> f 2 c <*> f 3 d <*> f 4 e <*> f 5 g <*> f 6 h <*> f 7 i <*> f 8 j+  {-# INLINE each #-}++#if MIN_VERSION_base(4,4,0)+instance (RealFloat a, RealFloat b) => Each Int (Complex a) (Complex b) a b where+  each = Lens.indexed $ \ f (a :+ b) -> (:+) <$> f (0 :: Int) a <*> f 1 b+  {-# INLINE each #-}+#else+instance Each Int (Complex a) (Complex b) a b where+  each = Lens.indexed $ \ f (a :+ b) -> (:+) <$> f (0 :: Int) a <*> f 1 b+  {-# INLINE each #-}+#endif++instance Each k (Map k a) (Map k b) a b where+  each = Lens.indexed $ \f m -> sequenceA $ Map.mapWithKey f m+  {-# INLINE each #-}++instance Each Int (IntMap a) (IntMap b) a b where+  each = Lens.indexed $ \f m -> sequenceA $ IntMap.mapWithKey f m+  {-# INLINE each #-}++instance Each k (HashMap k a) (HashMap k b) a b where+  each = Lens.indexed HashMap.traverseWithKey+  {-# INLINE each #-}++instance Each Int [a] [b] a b+instance Each Int (Identity a) (Identity b) a b+instance Each Int (Maybe a) (Maybe b) a b+instance Each Int (Seq a) (Seq b) a b+instance Each Int (Tree a) (Tree b) a b+instance Each Int (Vector.Vector a) (Vector.Vector b) a b++instance (Prim a, Prim b) => Each Int (Prim.Vector a) (Prim.Vector b) a b where+  each = Lens.indexed $ \f v -> Prim.fromListN (Prim.length v) <$> withIndex traversed f (Prim.toList v)++instance (Storable a, Storable b) => Each Int (Storable.Vector a) (Storable.Vector b) a b where+  each = Lens.indexed $ \f v -> Storable.fromListN (Storable.length v) <$> withIndex traversed f (Storable.toList v)++instance (Unbox a, Unbox b) => Each Int (Unboxed.Vector a) (Unboxed.Vector b) a b where+  each = Lens.indexed $ \f v -> Unboxed.fromListN (Unboxed.length v) <$> withIndex traversed f (Unboxed.toList v)++instance Each Int StrictT.Text StrictT.Text Char Char where+  each = iso StrictT.unpack StrictT.pack .> traversed+  {-# INLINE each #-}++instance Each Int64 LazyT.Text LazyT.Text Char Char where+  each = iso LazyT.unpack LazyT.pack .> traversed64+  {-# INLINE each #-}++instance Each Int StrictB.ByteString StrictB.ByteString Word8 Word8 where+  each = iso StrictB.unpack StrictB.pack .> traversed+  {-# INLINE each #-}++instance Each Int64 LazyB.ByteString LazyB.ByteString Word8 Word8 where+  each = iso LazyB.unpack LazyB.pack .> traversed64+  {-# INLINE each #-}++instance (Ix i, IArray UArray a, IArray UArray b) => Each i (Array i a) (Array i b) a b where+  each = Lens.indexed $ \f arr -> array (bounds arr) <$> traverse (\(i,a) -> (,) i <$> f i a) (IArray.assocs arr)+  {-# INLINE each #-}++instance (Ix i, IArray UArray a, IArray UArray b) => Each i (UArray i a) (UArray i b) a b where+  each = Lens.indexed $ \f arr -> array (bounds arr) <$> traverse (\(i,a) -> (,) i <$> f i a) (IArray.assocs arr)+  {-# INLINE each #-}
src/Control/Lens/Fold.hs view
@@ -46,6 +46,8 @@   , (^?!)   , preview   , previews+  , preuse+  , preuses   -- ** Building Folds   --, folds   , folding@@ -95,6 +97,7 @@ import Control.Lens.Type import Control.Monad import Control.Monad.Reader+import Control.Monad.State import Data.Foldable as Foldable import Data.Maybe import Data.Monoid@@ -886,7 +889,7 @@ -- -- Note: maximumOf on a valid 'Control.Lens.Iso.Iso', 'Lens' or 'Getter' will always return 'Just' a value. ----- @'maximum' ≡ 'fromMaybe' ('error' "empty") '.' 'maximumOf' 'folded'@+-- @'maximum' ≡ 'fromMaybe' ('error' \"empty\") '.' 'maximumOf' 'folded'@ -- -- @ -- 'maximumOf' ::          'Getter' s a           -> s -> 'Maybe' a@@ -904,7 +907,7 @@ -- -- Note: minimumOf on a valid 'Control.Lens.Iso.Iso', 'Lens' or 'Getter' will always return 'Just' a value. ----- @'minimum' ≡ 'Data.Maybe.fromMaybe' ('error' "empty") '.' 'minimumOf' 'folded'@+-- @'minimum' ≡ 'Data.Maybe.fromMaybe' ('error' \"empty\") '.' 'minimumOf' 'folded'@ -- -- @ -- 'minimumOf' ::          'Getter' s a           -> s -> 'Maybe' a@@ -921,7 +924,7 @@ -- Obtain the maximum element (if any) targeted by a 'Fold', 'Control.Lens.Traversal.Traversal', 'Lens', 'Control.Lens.Iso.Iso', -- or 'Getter' according to a user supplied ordering. ----- @'Data.Foldable.maximumBy' cmp ≡ 'Data.Maybe.fromMaybe' ('error' "empty") '.' 'maximumByOf' 'folded' cmp@+-- @'Data.Foldable.maximumBy' cmp ≡ 'Data.Maybe.fromMaybe' ('error' \"empty\") '.' 'maximumByOf' 'folded' cmp@ -- -- @ -- 'maximumByOf' :: 'Getter' s a           -> (a -> a -> 'Ordering') -> s -> 'Maybe' a@@ -940,7 +943,7 @@ -- Obtain the minimum element (if any) targeted by a 'Fold', 'Control.Lens.Traversal.Traversal', 'Lens', 'Control.Lens.Iso.Iso' -- or 'Getter' according to a user supplied ordering. ----- @'minimumBy' cmp ≡ 'Data.Maybe.fromMaybe' ('error' "empty") '.' 'minimumByOf' 'folded' cmp@+-- @'minimumBy' cmp ≡ 'Data.Maybe.fromMaybe' ('error' \"empty\") '.' 'minimumByOf' 'folded' cmp@ -- -- @ -- 'minimumByOf' :: 'Getter' s a           -> (a -> a -> 'Ordering') -> s -> 'Maybe' a@@ -1091,7 +1094,9 @@ -- | Useful for storing folds in containers. newtype ReifiedFold s a = ReifyFold { reflectFold :: Fold s a } --- * Previewing+------------------------------------------------------------------------------+-- Preview+------------------------------------------------------------------------------  -- | Retrieve the first value targeted by a 'Fold' or 'Control.Lens.Traversal.Traversal' (or 'Just' the result -- from a 'Getter' or 'Lens'). See also ('^?').@@ -1148,3 +1153,36 @@ previews :: MonadReader s m => Getting (First r) s t a b -> (a -> r) -> m (Maybe r) previews l f = asks (getFirst# (foldMapOf l (first# (Just . f)))) {-# INLINE previews #-}+++------------------------------------------------------------------------------+-- Preuse+------------------------------------------------------------------------------++-- | Retrieve the first value targeted by a 'Fold' or 'Control.Lens.Traversal.Traversal' (or 'Just' the result+-- from a 'Getter' or 'Lens') into the current state.+--+-- @+-- 'preuse' :: MonadState s m => 'Getter' s a           -> m ('Maybe' a)+-- 'preuse' :: MonadState s m => 'Fold' s a             -> m ('Maybe' a)+-- 'preuse' :: MonadState s m => 'Simple' 'Lens' s a      -> m ('Maybe' a)+-- 'preuse' :: MonadState s m => 'Simple' 'Control.Lens.Iso.Iso' s a       -> m ('Maybe' a)+-- 'preuse' :: MonadState s m => 'Simple' 'Control.Lens.Traversal.Traversal' s a -> m ('Maybe' a)+-- @+preuse :: MonadState s m => Getting (First a) s t a b -> m (Maybe a)+preuse l = gets (getFirst# (foldMapOf l (first# Just)))+{-# INLINE preuse #-}++-- | Retrieve a function of the first value targeted by a 'Fold' or+-- 'Control.Lens.Traversal.Traversal' (or 'Just' the result from a 'Getter' or 'Lens') into the current state.+--+-- @+-- 'preuses' :: MonadState s m => 'Getter' s a           -> (a -> r) -> m ('Maybe' r)+-- 'preuses' :: MonadState s m => 'Fold' s a             -> (a -> r) -> m ('Maybe' r)+-- 'preuses' :: MonadState s m => 'Simple' 'Lens' s a      -> (a -> r) -> m ('Maybe' r)+-- 'preuses' :: MonadState s m => 'Simple' 'Control.Lens.Iso.Iso' s a       -> (a -> r) -> m ('Maybe' r)+-- 'preuses' :: MonadState s m => 'Simple' 'Control.Lens.Traversal.Traversal' s a -> (a -> r) -> m ('Maybe' r)+-- @+preuses :: MonadState s m => Getting (First r) s t a b -> (a -> r) -> m (Maybe r)+preuses l f = gets (getFirst# (foldMapOf l (first# (Just . f))))+{-# INLINE preuses #-}
src/Control/Lens/Indexed.hs view
@@ -24,10 +24,12 @@   , reindexed   -- * Indexing existing lenses, traversals, etc.   , indexing+  , indexing64   ) where  import Control.Lens.Classes import Control.Lens.Internal+import Data.Int  infixr 9 <.>, <., .> @@ -62,18 +64,36 @@ icompose ijk (Indexed ibc) (Indexed jab) = indexed $ \ka -> ibc $ \i -> jab $ \j -> ka (ijk i j) {-# INLINE icompose #-} --- | Transform an 'Traversal' into an 'Control.Lens.IndexedTraversal.IndexedTraversal' or+-- | Transform a 'Traversal' into an 'Control.Lens.IndexedTraversal.IndexedTraversal' or -- a 'Fold' into an 'Control.Lens.IndexedFold.IndexedFold', etc. -- -- @ -- 'indexing' :: 'Control.Lens.Traversal.Traversal' s t a b -> 'Control.Lens.IndexedTraversal.IndexedTraversal' 'Int' s t a b--- 'indexing' :: 'Control.Lens.Prism.Prism' s t a b     -> 'Control.Lens.IndexedLens.IndexedTraversal' 'Int' s t a b--- 'indexing' :: 'Control.Lens.Type.Lens' s t a b      -> 'Control.Lens.IndexedLens.IndexedLens' 'Int' s t a b--- 'indexing' :: 'Control.Lens.Iso.Iso' s t a b       -> 'Control.Lens.IndexedLens.IndexedLens' 'Int' s t a b--- 'indexing' :: 'Control.Lens.Fold.Fold' s t          -> 'Control.Lens.IndexedFold.IndexedFold' 'Int' s t--- 'indexing' :: 'Control.Lens.Getter.Getter' s t        -> 'Control.Lens.IndexedGetter.IndexedGetter' 'Int' s t a b+-- 'indexing' :: 'Control.Lens.Prism.Prism' s t a b         -> 'Control.Lens.IndexedLens.IndexedTraversal' 'Int' s t a b+-- 'indexing' :: 'Control.Lens.Type.Lens' s t a b           -> 'Control.Lens.IndexedLens.IndexedLens' 'Int' s t a b+-- 'indexing' :: 'Control.Lens.Iso.Iso' s t a b             -> 'Control.Lens.IndexedLens.IndexedLens' 'Int' s t a b+-- 'indexing' :: 'Control.Lens.Fold.Fold' s t               -> 'Control.Lens.IndexedFold.IndexedFold' 'Int' s t+-- 'indexing' :: 'Control.Lens.Getter.Getter' s t           -> 'Control.Lens.IndexedGetter.IndexedGetter' 'Int' s t a b -- @ indexing :: Indexable Int k => ((a -> Indexing f b) -> s -> Indexing f t) -> k (a -> f b) (s -> f t) indexing l = indexed $ \iafb s -> case runIndexing (l (\a -> Indexing (\i -> i `seq` (iafb i a, i + 1))) s) 0 of   (r, _) -> r {-# INLINE indexing #-}++-- | Transform a 'Traversal' into an 'Control.Lens.IndexedTraversal.IndexedTraversal' or+-- a 'Fold' into an 'Control.Lens.IndexedFold.IndexedFold', etc.+--+-- This combinator is like 'indexing' except that it handles large 'Traversal's and 'Fold's gracefully.+--+-- @+-- 'indexing64' :: 'Control.Lens.Traversal.Traversal' s t a b -> 'Control.Lens.IndexedTraversal.IndexedTraversal' 'Int64' s t a b+-- 'indexing64' :: 'Control.Lens.Prism.Prism' s t a b         -> 'Control.Lens.IndexedLens.IndexedTraversal' 'Int64' s t a b+-- 'indexing64' :: 'Control.Lens.Type.Lens' s t a b           -> 'Control.Lens.IndexedLens.IndexedLens' 'Int64' s t a b+-- 'indexing64' :: 'Control.Lens.Iso.Iso' s t a b             -> 'Control.Lens.IndexedLens.IndexedLens' 'Int64' s t a b+-- 'indexing64' :: 'Control.Lens.Fold.Fold' s t               -> 'Control.Lens.IndexedFold.IndexedFold' 'Int64' s t+-- 'indexing64' :: 'Control.Lens.Getter.Getter' s t           -> 'Control.Lens.IndexedGetter.IndexedGetter' 'Int64' s t a b+-- @+indexing64 :: Indexable Int64 k => ((a -> Indexing64 f b) -> s -> Indexing64 f t) -> k (a -> f b) (s -> f t)+indexing64 l = indexed $ \iafb s -> case runIndexing64 (l (\a -> Indexing64 (\i -> i `seq` (iafb i a, i + 1))) s) 0 of+  (r, _) -> r+{-# INLINE indexing64 #-}
src/Control/Lens/IndexedTraversal.hs view
@@ -39,6 +39,7 @@   , TraverseMin(..)   , TraverseMax(..)   , traversed+  , traversed64   , elementOf   , element   , elementsOf@@ -70,6 +71,7 @@ import Control.Monad.Trans.State.Lazy as Lazy import Data.Hashable import Data.HashMap.Lazy as HashMap+import Data.Int import Data.IntMap as IntMap import Data.Map as Map import Data.Traversable@@ -216,6 +218,11 @@ traversed :: Traversable f => IndexedTraversal Int (f a) (f b) a b traversed = indexing traverse {-# INLINE traversed #-}++-- | Traverse any 'Traversable' container. This is an 'IndexedTraversal' that is indexed by ordinal position.+traversed64 :: Traversable f => IndexedTraversal Int64 (f a) (f b) a b+traversed64 = indexing64 traverse+{-# INLINE traversed64 #-}  -- | This provides a 'Traversal' that checks a predicate on a key before -- allowing you to traverse into a value.
src/Control/Lens/Internal.hs view
@@ -50,6 +50,7 @@   , Max(..), getMax   , Min(..), getMin   , Indexing(..)+  , Indexing64(..)   -- * Overloadings   , Prismoid(..)   , Isoid(..)@@ -66,6 +67,7 @@ import Prelude hiding ((.),id) import Data.Functor.Compose import Data.Functor.Identity+import Data.Int import Data.Monoid #ifndef SAFE import Unsafe.Coerce@@ -185,6 +187,24 @@  instance Gettable f => Gettable (Indexing f) where   coerce (Indexing m) = Indexing $ \i -> case m i of+    (ff, j) -> (coerce ff, j)++-- | Applicative composition of @'Control.Monad.Trans.State.Lazy.State' 'Int'@ with a 'Functor', used+-- by 'Control.Lens.Indexed.indexed'+newtype Indexing64 f a = Indexing64 { runIndexing64 :: Int64 -> (f a, Int64) }++instance Functor f => Functor (Indexing64 f) where+  fmap f (Indexing64 m) = Indexing64 $ \i -> case m i of+    (x, j) -> (fmap f x, j)++instance Applicative f => Applicative (Indexing64 f) where+  pure x = Indexing64 (\i -> (pure x, i))+  Indexing64 mf <*> Indexing64 ma = Indexing64 $ \i -> case mf i of+    (ff, j) -> case ma j of+       ~(fa, k) -> (ff <*> fa, k)++instance Gettable f => Gettable (Indexing64 f) where+  coerce (Indexing64 m) = Indexing64 $ \i -> case m i of     (ff, j) -> (coerce ff, j)  -- | Used internally by 'Control.Lens.Traversal.traverseOf_' and the like.
src/Control/Lens/Plated.hs view
@@ -344,7 +344,7 @@ -- For example, replacing negative literals with literals: -- -- @--- negLits = 'transform' $ \x -> case x of+-- negLits = 'transform' $ \\x -> case x of --   Neg (Lit i) -> Lit ('negate' i) --   _           -> x -- @
src/Control/Lens/Representable.hs view
@@ -136,7 +136,7 @@ -- | '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' Foo@: --@@ -173,7 +173,7 @@ -- | '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' Foo@: --@@ -189,7 +189,7 @@ -- | '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' Foo@: --@@ -204,7 +204,7 @@  -- | 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@ -- -- Usage for a @'Representable' Foo@: --@@ -245,7 +245,7 @@ -- | Map over a 'Representable' functor with access to the 'Lens' for the -- current position ----- @'rmap' f m = 'rep' '$' \i -> f i (m '^.' i)@+-- @'rmap' f m = 'rep' '$' \\i -> f i (m '^.' i)@ rmap :: Representable f => (Rep f -> a -> b) -> f a -> f b rmap f m = rep $ \i -> f i (m^.i) {-# INLINE rmap #-}
src/Control/Lens/Setter.hs view
@@ -103,7 +103,6 @@ -- 'over' l f '.' 'over' l g ≡ 'over' l (f '.' g) -- @ ----- -- These an be stated more directly: -- -- @
src/Control/Lens/TH.hs view
@@ -24,6 +24,7 @@     makeLenses, makeLensesFor   , makeClassy, makeClassyFor   , makeIso+  , makePrisms   -- * Configuring Lenses   , makeLensesWith   , defaultRules@@ -58,6 +59,7 @@ import Control.Lens.Getter import Control.Lens.IndexedLens import Control.Lens.Iso+import Control.Lens.Prism import Control.Lens.Setter import Control.Lens.Tuple import Control.Lens.Traversal@@ -68,7 +70,7 @@ import Data.Function (on) import Data.List as List import Data.Map as Map hiding (toList,map,filter)-import Data.Maybe (isNothing,isJust,catMaybes,fromJust)+import Data.Maybe (isNothing,isJust,catMaybes,fromJust,fromMaybe) import Data.Ord (comparing) import Data.Set as Set hiding (toList,map,filter) import Data.Set.Lens@@ -177,14 +179,16 @@  -- | Default lens rules defaultRules :: LensRules-defaultRules = LensRules top fld (const Nothing) $+defaultRules = LensRules mLowerName fld (const Nothing) $     Set.fromList [SingletonIso, SingletonAndField, CreateClass, CreateInstance, BuildTraversals, GenerateSignatures]   where-    top (c:cs) = Just (toLower c:cs)-    top _      = Nothing-    fld ('_':c:cs) = Just (toLower c:cs)-    fld _          = Nothing+    fld ('_':cs) = mLowerName cs+    fld _        = Nothing +mLowerName :: String -> Maybe String+mLowerName (c:cs) = Just (toLower c:cs)+mLowerName _ = Nothing+ -- | Rules for making fairly simple partial lenses, ignoring the special cases -- for isomorphisms and traversals, and not making any classes. lensRules :: LensRules@@ -302,13 +306,113 @@             | otherwise              -> makeFieldLenses cfg ctx tyConName args cons         _ -> fail "makeLensesWith: Unsupported data type"       _ -> fail "makeLensesWith: Expected the name of a data type or newtype"-  where-    deNewtype (NewtypeD ctx tyConName args c d) = DataD ctx tyConName args [c] d-    deNewtype d = d +makePrisms :: Name -> Q [Dec]+makePrisms nm = do+    inf <- reify nm+    case inf of+      TyConI decl -> case deNewtype decl of+        DataD ctx tyConName args cons _ ->+          makePrismsForCons ctx tyConName args cons+        _ -> fail "makePrisms: Unsupported data type"+      _ -> fail "makePrisms: Expected the name of a data type or newtype"+ ----------------------------------------------------------------------------- -- Internal TH Implementation -----------------------------------------------------------------------------++-- | Transform @NewtypeD@s declarations to @DataD@s+deNewtype :: Dec -> Dec+deNewtype (NewtypeD ctx tyConName args c d) = DataD ctx tyConName args [c] d+deNewtype d = d++makePrismsForCons :: [Pred] -> Name -> [TyVarBndr] -> [Con] -> Q [Dec]+makePrismsForCons ctx tyConName args cons =+  concat <$> mapM (makePrismForCon ctx tyConName args canModifyTypeVar cons) cons+  where+    conTypeVars = map (Set.fromList . toListOf typeVars) cons+    canModifyTypeVar = (`Set.member` typeVarsOnlyInOneCon) . view name+    typeVarsOnlyInOneCon =+      Set.fromList . concat . filter ((== 1) . length) .+      List.group . List.sort . concat $+      map toList conTypeVars++makePrismForCon :: [Pred] -> Name -> [TyVarBndr] -> (TyVarBndr -> Bool) -> [Con] -> Con -> Q [Dec]+makePrismForCon ctx tyConName args canModifyTypeVar allCons con =+    return+    [ SigD resName .+      ForallT+        (args ++ (PlainTV <$> Map.elems altArgs))+        (List.nub (ctx ++ substTypeVars altArgs ctx)) $+      List.foldl1 AppT+      [ ConT ''Prism+      , List.foldl AppT (ConT tyConName) (VarT . view name <$> args)+      , List.foldl AppT (ConT tyConName) (VarT . view name <$> substTypeVars altArgs args)+      , toTupleT fieldTypes+      , toTupleT $ substTypeVars altArgs fieldTypes+      ]+    , FunD resName+      [ Clause []+        (NormalB (List.foldl1 AppE [VarE 'prism, VarE remiterName, VarE reviewerName]))+        [remiter, reviewer]+      ]+    ]+  where+    (dataConName, fieldTypes) = ctrNameAndFieldTypes con+    resName =+      mkName .+      fromMaybe (error ("bad constructor name: " ++ show dataConName)) . mLowerName $+      nameBase dataConName+    altArgs = Map.fromList . map (mkAltArg . view name) $ filter isAltArg args+    isAltArg arg = canModifyTypeVar arg && Set.member (arg ^. name) conArgs+    conArgs = Set.fromList $ toListOf typeVars fieldTypes+    mkAltArg arg = (arg, mkName (nameBase arg ++ "'"))+    reviewerName = mkName "reviewer"+    reviewer = FunD reviewerName $ hitClause : missClauses+    hitClause =+      Clause [ConP dataConName (VarP <$> varNames)]+      ((NormalB . AppE (ConE 'Right) . toTupleE) (VarE <$> varNames)) []+    missClauses+      | Map.null altArgs =+        [Clause [VarP xName] (NormalB (AppE (ConE 'Left) (VarE xName))) []]+      | otherwise =+        reviewerIdClause <$> filter (/= con) allCons+    varNames = map (mkName . ('x' :) . show) [0 .. length fieldTypes - 1]+    xName = mkName "x"+    remiterName = mkName "remiter"+    remiter =+      FunD remiterName+      [ Clause [toTupleP (VarP <$> varNames)]+        (NormalB (List.foldl AppE (ConE dataConName) (VarE <$> varNames))) []+      ]++ctrNameAndFieldTypes :: Con -> (Name, [Type])+ctrNameAndFieldTypes (NormalC n ts) = (n, snd <$> ts)+ctrNameAndFieldTypes (RecC n ts) = (n, view _3 <$> ts)+ctrNameAndFieldTypes (InfixC l n r) = (n, [snd l, snd r])+ctrNameAndFieldTypes (ForallC _ _ c) = ctrNameAndFieldTypes c++-- When a prism can change type variables it needs to pattern match on all+-- other data constructors and rebuild the data so it will have the new type.+reviewerIdClause :: Con -> Clause+reviewerIdClause con =+    Clause [ConP dataConName (VarP <$> varNames)]+    ((NormalB . AppE (ConE 'Left)) (List.foldl AppE (ConE dataConName) (VarE <$> varNames))) []+  where+    (dataConName, fieldTypes) = ctrNameAndFieldTypes con+    varNames = map (mkName . ('x' :) . show) [0 .. length fieldTypes - 1]++toTupleT :: [Type] -> Type+toTupleT [x] = x+toTupleT xs = List.foldl AppT (TupleT (length xs)) xs++toTupleE :: [Exp] -> Exp+toTupleE [x] = x+toTupleE xs = TupE xs++toTupleP :: [Pat] -> Pat+toTupleP [x] = x+toTupleP xs = TupP xs  -- | Given a set of names, build a map from those names to a set of fresh names based on them. freshMap :: Set Name -> Q (Map Name Name)
src/Control/Lens/Traversal.hs view
@@ -344,14 +344,14 @@ -- -- So technically, this is only a lens if you do not change the number of results it returns. ----- When applied to a 'Fold' the result is merely a 'Getter'.+-- When applied to a 'Fold' the result is merely a 'Control.Lens.Getter.Getter'. -- -- @ -- 'partsOf' :: 'Simple' 'Control.Lens.Iso.Iso' s a       -> 'Simple' 'Lens' s [a] -- 'partsOf' :: 'Simple' 'Lens' s a      -> 'Simple' 'Lens' s [a] -- 'partsOf' :: 'Simple' 'Traversal' s a -> 'Simple' 'Lens' s [a]--- 'partsOf' :: 'Fold' s a             -> 'Getter' s [a]--- 'partsOf' :: 'Getter' s a           -> 'Getter' s [a]+-- 'partsOf' :: 'Fold' s a             -> 'Control.Lens.Getter.Getter' s [a]+-- 'partsOf' :: 'Control.Lens.Getter.Getter' s a           -> 'Control.Lens.Getter.Getter' s [a] -- @ partsOf :: Functor f => LensLike (BazaarT a a f) s t a a -> LensLike f s t [a] [a] partsOf l f s = outsT b <$> f (insT b) where b = l sellT s@@ -373,14 +373,14 @@ -- This is unsafe because if you don't supply at least as many @b@'s as you were -- given @a@'s, then the reconstruction of @t@ /will/ result in an error! ----- When applied to a 'Fold' the result is merely a 'Getter' (and becomes safe).+-- When applied to a 'Fold' the result is merely a 'Control.Lens.Getter.Getter' (and becomes safe). -- -- @ -- 'unsafePartsOf' :: 'Control.Lens.Iso.Iso' s t a b       -> 'Lens' s t [a] [b] -- 'unsafePartsOf' :: 'Lens' s t a b      -> 'Lens' s t [a] [b] -- 'unsafePartsOf' :: 'Traversal' s t a b -> 'Lens' s t [a] [b]--- 'unsafePartsOf' :: 'Fold' s a          -> 'Getter' s [a]--- 'unsafePartsOf' :: 'Getter' s a        -> 'Getter' s [a]+-- 'unsafePartsOf' :: 'Fold' s a          -> 'Control.Lens.Getter.Getter' s [a]+-- 'unsafePartsOf' :: 'Control.Lens.Getter.Getter' s a        -> 'Control.Lens.Getter.Getter' s [a] -- @ unsafePartsOf :: Functor f => LensLike (BazaarT a b f) s t a b -> LensLike f s t [a] [b] unsafePartsOf l f s = unsafeOutsT b <$> f (insT b) where b = l sellT s@@ -411,16 +411,16 @@   f (x:xs) g = Context (g . (:xs)) x : f xs (g . (x:)) {-# INLINE holesOf #-} --- | This converts a 'Traversal' that you "know" will target one or more elements to a 'Lens'. It can--- also be used to transform a non-empty 'Fold' into a 'Getter' or a non-empty 'Control.Lens.Action.MonadicFold' into an+-- | This converts a 'Traversal' that you \"know\" will target one or more elements to a 'Lens'. It can+-- also be used to transform a non-empty 'Fold' into a 'Control.Lens.Getter.Getter' or a non-empty 'Control.Lens.Action.MonadicFold' into an -- 'Control.Lens.Action.Action'. ----- The resulting 'Lens', 'Getter', or 'Control.Lens.Action.Action' will be partial if the supplied traversal returns+-- The resulting 'Lens', 'Control.Lens.Getter.Getter', or 'Control.Lens.Action.Action' will be partial if the supplied traversal returns -- no results. -- -- @ -- 'singular' :: 'Traversal' s t a a -> 'Lens' s t a a--- 'singular' :: 'Fold' s a          -> 'Getter' s a+-- 'singular' :: 'Fold' s a          -> 'Control.Lens.Getter.Getter' s a -- 'singular' :: 'Control.Lens.Action.MonadicFold' m s a -> 'Control.Lens.Action.Action' m s a -- @ singular :: Functor f => LensLike (BazaarT a a f) s t a a -> LensLike f s t a a@@ -428,15 +428,15 @@   (a:as) -> (:as) <$> f a   []     -> [] <$ f (error "singular: empty traversal") --- | This converts a 'Traversal' that you "know" will target only one element to a 'Lens'. It can also be--- used to transform a 'Fold' into a 'Getter' or a 'Control.Lens.Action.MonadicFold' into an 'Control.Lens.Action.Action'.+-- | This converts a 'Traversal' that you \"know\" will target only one element to a 'Lens'. It can also be+-- used to transform a 'Fold' into a 'Control.Lens.Getter.Getter' or a 'Control.Lens.Action.MonadicFold' into an 'Control.Lens.Action.Action'. ----- The resulting 'Lens', 'Getter', or 'Control.Lens.Action.Action' will be partial if the Traversal targets nothing+-- The resulting 'Lens', 'Control.Lens.Getter.Getter', or 'Control.Lens.Action.Action' will be partial if the Traversal targets nothing -- or more than one element. -- -- @ -- 'unsafeSingular' :: 'Traversal' s t a b -> 'Lens' s t a b--- 'unsafeSingular' :: 'Fold' s a          -> 'Getter' s a+-- 'unsafeSingular' :: 'Fold' s a          -> 'Control.Lens.Getter.Getter' s a -- 'unsafeSingular' :: 'Control.Lens.Action.MonadicFold' m s a -> 'Control.Lens.Action.Action' m s a -- @ unsafeSingular :: Functor f => LensLike (BazaarT a b f) s t a b -> LensLike f s t a b@@ -522,7 +522,7 @@ beside l r f ~(s,s') = (,) <$> l f s <*> r f s' {-# INLINE beside #-} --- | Visit the first /n/ targets of a 'Traversal', 'Fold', 'Getter' or 'Lens'.+-- | Visit the first /n/ targets of a 'Traversal', 'Fold', 'Control.Lens.Getter.Getter' or 'Lens'. -- -- >>> [("hello","world"),("!!!","!!!")]^.. taking 2 (traverse.both) -- ["hello","world"]@@ -536,7 +536,7 @@ taking n l f s = outsT b <$> traverse f (take n $ insT b) where b = l sellT s {-# INLINE taking #-} --- | Visit all but the first /n/ targets of a 'Traversal', 'Fold', 'Getter' or 'Lens'.+-- | Visit all but the first /n/ targets of a 'Traversal', 'Fold', 'Control.Lens.Getter.Getter' or 'Lens'. -- -- >>> ("hello","world") ^? dropping 1 both -- Just "world"
src/Control/Lens/Type.hs view
@@ -315,9 +315,9 @@ -- 'choosing' :: 'Simple' 'Control.Lens.Setter.Setter' s a    -> 'Simple' 'Control.Lens.Setter.Setter' s' a    -> 'Simple' 'Control.Lens.Setter.Setter' ('Either' s s') a -- @ choosing :: Functor f-       => LensLike f s t a a-       -> LensLike f s' t' a a-       -> LensLike f (Either s s') (Either t t') a a+       => LensLike f s t a b+       -> LensLike f s' t' a b+       -> LensLike f (Either s s') (Either t t') a b choosing l _ f (Left a)   = Left <$> l f a choosing _ r f (Right a') = Right <$> r f a' {-# INLINE choosing #-}@@ -386,9 +386,8 @@ -- -- Note: This only accepts a proper 'Lens'. ----- > :t let example l x = set (cloneLens l) (x^.cloneLens l + 1) x in example--- > let example l x = set (cloneLens l) (x^.cloneLens l + 1) x in example--- >   :: Num b => LensLike (Context b b) s t b b -> s -> t+-- >>> let example l x = set (cloneLens l) (x^.cloneLens l + 1) x in example _2 ("hello",1,"you")+-- ("hello",2,"you") cloneLens :: Functor f   => LensLike (Context a b) s t a b   -> (a -> f b) -> s -> f t
src/Control/Lens/Wrapped.hs view
@@ -42,6 +42,7 @@ ---------------------------------------------------------------------------- module Control.Lens.Wrapped   ( Wrapped(..)+  , unwrapped   , wrapping, unwrapping   , wrappings, unwrappings   , op
src/Data/Data/Lens.hs view
@@ -123,7 +123,7 @@ -- | Find descendants of type @a@ non-transitively, while avoiding computation of areas that cannot contain values of -- type @a@ using 'Data'. ----- 'uniplate' is a useful default definition for 'Control.Plated.plate'+-- 'uniplate' is a useful default definition for 'Control.Lens.Plated.plate' uniplate :: Data a => Simple Traversal a a uniplate = template {-# INLINE uniplate #-}
src/Language/Haskell/TH/Lens.hs view
@@ -30,6 +30,7 @@ import Control.Lens.Fold import Control.Lens.IndexedLens import Control.Lens.IndexedTraversal+import Control.Lens.Tuple import Control.Lens.Type import Control.Lens.Traversal import Data.Map as Map hiding (toList,map)@@ -86,6 +87,14 @@ instance HasTypeVars Pred where   typeVarsEx s f (ClassP n ts) = ClassP n <$> typeVarsEx s f ts   typeVarsEx s f (EqualP l r)  = EqualP <$> typeVarsEx s f l <*> typeVarsEx s f r++instance HasTypeVars Con where+  typeVarsEx s f (NormalC n ts) = NormalC n <$> traverseOf (traverse . _2) (typeVarsEx s f) ts+  typeVarsEx s f (RecC n ts) = RecC n <$> traverseOf (traverse . _3) (typeVarsEx s f) ts+  typeVarsEx s f (InfixC l n r) = InfixC <$> g l <*> pure n <*> g r+       where g (i, t) = (,) i <$> typeVarsEx s f t+  typeVarsEx s f (ForallC bs ctx c) = ForallC bs <$> typeVarsEx s' f ctx <*> typeVarsEx s' f c+       where s' = s `Set.union` setOf typeVars bs  instance HasTypeVars t => HasTypeVars [t] where   typeVarsEx s = traverse . typeVarsEx s
tests/hunit.hs view
@@ -43,6 +43,9 @@  makeLenses ''Polygon +data Shape = SBox Box | SPolygon Polygon | SCircle Point Int | SVoid+makePrisms ''Shape+ origin =   Point { _x = 0, _y = 0 }
tests/properties.hs view
@@ -13,16 +13,19 @@ import Data.Functor.Identity import System.Exit import Test.QuickCheck-import Test.QuickCheck.All import Test.QuickCheck.Function+import Test.Framework.TH+import Test.Framework.Providers.QuickCheck2 import Data.Text.Strict.Lens import Data.List.Lens import Data.Functor.Compose  +-- The first setter law: setter_id :: Eq s => Simple Setter s a -> s -> Bool-setter_id l s = runIdentity (l Identity s) == s+setter_id l s = over l id s == s +--  The second setter law: setter_composition :: Eq s => Simple Setter s a -> s -> Fun a a -> Fun a a -> Bool setter_composition l s (Fun _ f) (Fun _ g) = over l f (over l g s) == over l (f . g) s @@ -41,9 +44,12 @@ iso_yon :: Eq a => Simple AnIso s a -> a -> Bool iso_yon l a = a^.from l.cloneIso l == a -prism_yen :: Eq a => Simple APrism s a -> a -> Bool-prism_yen l a = a^.remit l^?clonePrism l == Just a+prism_yin :: Eq a => Simple Prism s a -> a -> Bool+prism_yin l a = preview l (review l a) == Just a +prism_yang :: Eq s => Simple Prism s a -> s -> Bool+prism_yang l s = maybe s (review l) (preview l s) == s+ traverse_pure :: forall f s a. (Applicative f, Eq (f s)) => SimpleLensLike f s a -> s -> Bool traverse_pure l s = l pure s == (pure s :: f s) @@ -80,7 +86,7 @@  isPrism :: (Arbitrary s, Arbitrary a, CoArbitrary a, Show s, Show a, Eq s, Eq a, Function a)       => Simple Prism s a -> Property-isPrism l = isTraversal l .&. prism_yen l+isPrism l = isTraversal l .&. prism_yin l .&. prism_yang l  -- an illegal lens bad :: Simple Lens (Int,Int) Int@@ -127,6 +133,4 @@ --prop_text                           = isIso packed  main :: IO ()-main = do-  b <- $quickCheckAll-  unless b $ exitWith (ExitFailure 1)+main = $defaultMainGenerator