lens 0.5 → 0.6
raw patch · 3 files changed
+118/−52 lines, 3 files
Files
- lens.cabal +8/−3
- src/Control/Lens.hs +33/−49
- src/Control/Lens/Internal.hs +77/−0
lens.cabal view
@@ -1,6 +1,6 @@ name: lens category: Data, Lenses-version: 0.5+version: 0.6 license: BSD3 cabal-version: >= 1.6 license-file: LICENSE@@ -25,8 +25,8 @@ Control.Lens Control.Lens.Rep Control.Lens.TH- ghc-options: -Wall -fwarn-tabs -O2 -fdicts-cheap -funbox-strict-fields- hs-source-dirs: src+ Control.Lens.Internal+ build-depends: base == 4.*, bytestring == 0.9.*,@@ -34,11 +34,16 @@ mtl >= 2.1.1 && < 2.2, template-haskell >= 2.4 && < 2.8, transformers >= 0.2 && < 0.4+ other-extensions: CPP Rank2Types RankNTypes TemplateHaskell+ if (impl(ghc>=7.4)) other-extensions: Safe Trustworthy++ ghc-options: -Wall -fwarn-tabs -O2 -fdicts-cheap -funbox-strict-fields+ hs-source-dirs: src
src/Control/Lens.hs view
@@ -160,13 +160,10 @@ -- , indexOf - -- * Implementation details- , IndexedStore- , Focusing- , Traversed ) where import Control.Applicative as Applicative+import Control.Lens.Internal import Control.Monad (liftM, MonadPlus(..)) import Control.Monad.State.Class import qualified Control.Monad.Trans.State.Lazy as Lazy@@ -536,6 +533,10 @@ 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 -> Lens b Bool bitAt n f b = (\x -> if x then setBit b n else clearBit b n) <$> f (testBit b n) {-# INLINE bitAt #-}@@ -559,18 +560,6 @@ access l = gets (^. l) {-# INLINE access #-} -newtype Focusing m c a = Focusing { unfocusing :: m (c, a) }--instance Monad m => Functor (Focusing m c) where- fmap f (Focusing m) = Focusing (liftM (fmap f) m)--instance (Monad m, Monoid c) => Applicative (Focusing m c) where- pure a = Focusing (return (mempty, a))- Focusing mf <*> Focusing ma = Focusing $ do- (c, f) <- mf- (d, a) <- ma- return (mappend c d, f a)- -- | This class allows us to use 'focus' on a number of different monad transformers. class Focus st where -- | Use a lens to lift an operation with simpler context into a larger context@@ -950,15 +939,15 @@ -- | A Traversal of the nth element of a Traversal -- -- > traverseHead = elementOf traverse 0-elementOf :: Applicative f => ((c -> SA f c) -> a -> SA f b) -> Int -> (c -> f c) -> a -> f b+elementOf :: Applicative f => ((c -> AppliedState f c) -> a -> AppliedState f b) -> Int -> (c -> f c) -> a -> f b elementOf l = elementsOf l . (==) -- | A Traversal of the elements at positions in a Traversal where the positions satisfy a predicate -- -- > traverseTail = elementsOf traverse (>0)-elementsOf :: Applicative f => ((c -> SA f c) -> a -> SA f b) -> (Int -> Bool) -> (c -> f c) -> a -> f b-elementsOf l p f ta = fst (runSA (l go ta) 0) where- go a = SA $ \i -> (if p i then f a else pure a, i + 1)+elementsOf :: Applicative f => ((c -> AppliedState f c) -> a -> AppliedState f b) -> (Int -> Bool) -> (c -> f c) -> a -> f b+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) -- | --@@ -1066,11 +1055,11 @@ -- -- > traverseElements :: Applicative f, Traversable t) => (Int -> Bool) -> (a -> f a) -> t a -> f (t a) traverseElements :: Traversable t => (Int -> Bool) -> Traversal (t a) a-traverseElements p f ta = fst (runSA (traverse go ta) 0) where- go a = SA $ \i -> (if p i then f a else pure a, i + 1)+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 #-} -+-- | Provides ad hoc overloading for 'traverseByteString' class TraverseByteString t where -- | Traverse the individual bytes in a ByteString --@@ -1083,7 +1072,12 @@ instance TraverseByteString Lazy.ByteString where traverseByteString f = fmap Lazy.pack . traverse f . Lazy.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 :: Traversal (t v) v -- default traverseValueAtMin :: Traversable t => Traversal (t v) v -- traverseValueAtMin = traverseElement 0@@ -1106,7 +1100,12 @@ a :< as -> (<| as) <$> f a EmptyL -> pure m +-- | Types that support traversal of the value of the maximal key+--+-- This is separate from 'TraverseValueAtMn' 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 :: Traversal (t v) v instance TraverseValueAtMax (Map k) where@@ -1127,6 +1126,17 @@ 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 => Traversal b Bool traverseBits f b = Prelude.foldr step 0 <$> traverse g bits where@@ -1163,29 +1173,3 @@ --indexOf l = l (^.) --{-# INLINE indexOf #-} ---------------------------------------------------------------------------------- Implementation details---------------------------------------------------------------------------------data IndexedStore c d a = IndexedStore (d -> a) c--instance Functor (IndexedStore c d) where- fmap f (IndexedStore g c) = IndexedStore (f . g) c--newtype SA f a = SA { runSA :: Int -> (f a, Int) }--instance Functor f => Functor (SA f) where- fmap f (SA m) = SA $ \i -> case m i of- (fa, j) -> (fmap f fa, j)--instance Applicative f => Applicative (SA f) where- pure a = SA (\i -> (pure a, i))- SA mf <*> SA ma = SA $ \i -> case mf i of- (ff, j) -> case ma j of- (fa, k) -> (ff <*> fa, k)--newtype Traversed f = Traversed { getTraversed :: f () }--instance Applicative f => Monoid (Traversed f) where- mempty = Traversed (pure ())- Traversed ma `mappend` Traversed mb = Traversed (ma *> mb)
+ src/Control/Lens/Internal.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE CPP #-}+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 704+{-# LANGUAGE Safe #-}+#endif+-----------------------------------------------------------------------------+-- |+-- Module : Control.Lens.Internal+-- Copyright : (C) 2012 Edward Kmett+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Edward Kmett <ekmett@gmail.com>+-- Stability : provisional+-- Portability : Rank2Types+--+-- These are some of the explicit Functor instances that leak into the+-- type signatures of Control.Lens. You shouldn't need to import this+-- module directly, unless you are coming up with a whole new kind of+-- \"Family\" and need to add instances.+--+----------------------------------------------------------------------------+module Control.Lens.Internal+ (+ -- * Implementation details+ IndexedStore(..)+ , Focusing(..)+ , Traversed(..)+ , AppliedState(..)+ ) where++import Control.Applicative+import Data.Monoid++-- | Used by 'Focus'++newtype Focusing m c a = Focusing { unfocusing :: m (c, a) }++instance Monad m => Functor (Focusing m c) where+ fmap f (Focusing m) = Focusing $ do+ (c, a) <- m+ return (c, f a)++instance (Monad m, Monoid c) => Applicative (Focusing m c) where+ pure a = Focusing (return (mempty, a))+ Focusing mf <*> Focusing ma = Focusing $ do+ (c, f) <- mf+ (d, a) <- ma+ return (mappend c d, f a)++-- | The indexed store can be used to characterize a 'LensFamily'+-- and is used by 'clone'++data IndexedStore c d a = IndexedStore (d -> a) c++instance Functor (IndexedStore c d) where+ fmap f (IndexedStore g c) = IndexedStore (f . g) c++-- | Applicative composition of @State Int@ with a 'Functor', used+-- by 'elementOf', 'elementsOf', 'traverseElement', 'traverseElementsOf'++newtype AppliedState f a = AppliedState { runAppliedState :: Int -> (f a, Int) }++instance Functor f => Functor (AppliedState f) where+ fmap f (AppliedState m) = AppliedState $ \i -> case m i of+ (fa, j) -> (fmap f fa, j)++instance Applicative f => Applicative (AppliedState f) where+ pure a = AppliedState (\i -> (pure a, i))+ AppliedState mf <*> AppliedState ma = AppliedState $ \i -> case mf i of+ (ff, j) -> case ma j of+ (fa, k) -> (ff <*> fa, k)++-- | Used internally by 'traverseOf_', 'mapM_' and the like.++newtype Traversed f = Traversed { getTraversed :: f () }++instance Applicative f => Monoid (Traversed f) where+ mempty = Traversed (pure ())+ Traversed ma `mappend` Traversed mb = Traversed (ma *> mb)