Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Refactored 'at' and 'contains' into 'Control.Lens.IndexedLens'

  • Loading branch information...
commit a23571cf9bde30a3448e399281da0a4384b90987 1 parent 86f791d
@ekmett authored
View
5 README.markdown
@@ -9,6 +9,11 @@ An overview of the [derivation](https://github.com/ekmett/lens/wiki/Derivation)
Documentation is available through [github](https://ekmett.github.com/lens) or [hackage](http://hackage.haskell.org/package/lens).
+Plated
+------
+
+New in version 2.5 is a port of the `Uniplate` API, updated to use `Traversal`. The Data-derived `biplate` and `uniplate` combinators run about 25% faster than the original `uniplate`, and you can use any of the other combinators, since `biplate` and `uniplate` are now just traversals.
+
Examples
--------
View
66 src/Control/Lens/IndexedLens.hs
@@ -1,9 +1,10 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE Rank2Types #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FunctionalDependencies #-}
#ifndef MIN_VERSION_mtl
#define MIN_VERSION_mtl(x,y,z) 1
@@ -23,11 +24,14 @@ module Control.Lens.IndexedLens
(
-- * Indexed Lenses
IndexedLens
+ -- * Common Indexed Lenses
+ , At(..)
+ , Contains(..)
+ -- * Indexed Lens Combinators
, (%%@~)
, (<%@~)
, (%%@=)
, (<%@=)
-
-- * Storing Indexed Lenses
, ReifiedIndexedLens(..)
-- * Simple
@@ -35,9 +39,18 @@ module Control.Lens.IndexedLens
, SimpleReifiedIndexedLens
) where
+import Control.Applicative
import Control.Lens.Indexed
import Control.Lens.Type
import Control.Monad.State.Class as State
+import Data.Hashable
+import Data.HashMap.Lazy as HashMap
+import Data.IntMap as IntMap
+import Data.Map as Map
+
+import Data.HashSet as HashSet
+import Data.IntSet as IntSet
+import Data.Set as Set
infixr 4 %%@~, <%@~
infix 4 %%@=, <%@=
@@ -121,6 +134,53 @@ l %%@= f = do
l <%@= f = l %%@= \ i c -> let d = f i c in (d, d)
{-# INLINE (<%@=) #-}
+-- | Provides an 'IndexedLens' that can be used to read, write or delete the value associated with a key in a map-like container.
+class At k m | m -> k where
+ -- |
+ -- >>> Map.fromList [(1,"hello")] ^.at 1
+ -- Just "hello"
+ --
+ -- >>> at 1 .~ Just "hello" $ Map.empty
+ -- fromList [(1,"hello")]
+ at :: k -> SimpleIndexedLens k (m v) (Maybe v)
+
+instance At Int IntMap where
+ at k = index $ \ f m -> (`go` m) <$> f k (IntMap.lookup k m) where
+ go Nothing = IntMap.delete k
+ go (Just v') = IntMap.insert k v'
+ {-# INLINE at #-}
+
+instance Ord k => At k (Map k) where
+ at k = index $ \ f m -> (`go` m) <$> f k (Map.lookup k m) where
+ go Nothing = Map.delete k
+ go (Just v') = Map.insert k v'
+ {-# INLINE at #-}
+
+instance (Eq k, Hashable k) => At k (HashMap k) where
+ at k = index $ \ f m -> (`go` m) <$> f k (HashMap.lookup k m) where
+ go Nothing = HashMap.delete k
+ go (Just v') = HashMap.insert k v'
+ {-# INLINE at #-}
+
+-- | Provides an 'IndexedLens' that can be used to read, write or delete a member of a set-like container
+class Contains k m | m -> k where
+ -- |
+ -- > ghci> contains 3 +~ False $ fromList [1,2,3,4]
+ -- > fromList [1,2,4]
+ contains :: k -> SimpleIndexedLens k m Bool
+
+instance Contains Int IntSet where
+ contains k = index $ \ f s -> (\b -> if b then IntSet.insert k s else IntSet.delete k s) <$> f k (IntSet.member k s) where
+ {-# INLINE contains #-}
+
+instance Ord k => Contains k (Set k) where
+ contains k = index $ \ f s -> (\b -> if b then Set.insert k s else Set.delete k s) <$> f k (Set.member k s) where
+ {-# INLINE contains #-}
+
+instance (Eq k, Hashable k) => Contains k (HashSet k) where
+ contains k = index $ \ f s -> (\b -> if b then HashSet.insert k s else HashSet.delete k s) <$> f k (HashSet.member k s) where
+ {-# INLINE contains #-}
+
------------------------------------------------------------------------------
-- Reifying Indexed Lenses
------------------------------------------------------------------------------
View
19 src/Control/Lens/IndexedTraversal.hs
@@ -17,6 +17,11 @@ module Control.Lens.IndexedTraversal
(
-- * Indexed Traversals
IndexedTraversal
+
+ -- * Common Indexed Traversals
+ , traverseAt
+
+ -- * Indexed Traversal Combinators
, itraverseOf
, iforOf
, imapMOf
@@ -26,6 +31,7 @@ module Control.Lens.IndexedTraversal
-- * Storing Indexed Traversals
, ReifiedIndexedTraversal(..)
+
-- * Simple
, SimpleIndexedTraversal
, SimpleReifiedIndexedTraversal
@@ -34,8 +40,10 @@ module Control.Lens.IndexedTraversal
import Control.Applicative
import Control.Applicative.Backwards
import Control.Lens.Indexed
+import Control.Lens.IndexedLens
import Control.Lens.Type
import Control.Monad.Trans.State.Lazy as Lazy
+import Data.Traversable
------------------------------------------------------------------------------
-- Indexed Traversals
@@ -150,6 +158,17 @@ swap (a,b) = (b,a)
{-# INLINE swap #-}
------------------------------------------------------------------------------
+-- Common indexed traversals
+------------------------------------------------------------------------------
+
+-- | Traverse the value at a given key in a map
+--
+-- @'traverseAt' k = 'at' k '<.' 'traverse'@
+traverseAt :: At k m => k -> SimpleIndexedTraversal k (m v) v
+traverseAt k = at k <. traverse
+{-# INLINE traverseAt #-}
+
+------------------------------------------------------------------------------
-- Reifying Indexed Traversals
------------------------------------------------------------------------------
View
1  src/Control/Lens/Internal.hs
@@ -471,7 +471,6 @@ instance Applicative Mutator where
pure = Mutator
Mutator f <*> Mutator a = Mutator (f a)
-
{-
data Bazaar c d a
= Buy a
View
4 src/Control/Lens/TH.hs
@@ -40,12 +40,12 @@ import Control.Lens.Setter
import Control.Lens.Tuple
import Control.Lens.Traversal
import Control.Lens.Type
+import Control.Lens.IndexedLens
import Control.Monad
import Data.Char (toLower)
import Data.Foldable
import Data.List as List
import Data.Map as Map hiding (toList,map,filter)
-import Data.Map.Lens
import Data.Maybe (isNothing,isJust)
import Data.Monoid
import Data.Set as Set hiding (toList,map,filter)
@@ -262,7 +262,7 @@ conFieldDescs (RecC _ fields) = fieldDescs mempty fields
conFieldDescs _ = []
commonFieldDescs :: [Con] -> [FieldDesc]
-commonFieldDescs = toList . Prelude.foldr walk mempty where
+commonFieldDescs = toList . Prelude.foldr walk Map.empty where
walk con m = Prelude.foldr step m (conFieldDescs con)
step d@(FieldDesc nm ty bds) m = case m^.at nm of
Just (FieldDesc _ _ bds') -> at nm .~ Just (FieldDesc nm ty (bds `Set.union` bds')) $ m
View
28 src/Data/HashMap/Lens.hs
@@ -12,42 +12,16 @@
--
----------------------------------------------------------------------------
module Data.HashMap.Lens
- ( at
- , traverseMap
- , traverseAt
+ ( traverseMap
) where
-import Control.Applicative as Applicative
-import Control.Lens.Traversal
import Control.Lens.Indexed
-import Control.Lens.IndexedLens
import Control.Lens.IndexedTraversal
-import Data.Hashable
import Data.HashMap.Lazy as HashMap
--- | This 'Lens' can be used to read, write or delete the value associated with a key in a 'HashMap'.
---
--- >>> :m + Control.Lens Data.HashMap.Lens
---
--- >>> HashMap.fromList [("hello",12)] ^.at "hello"
--- Just 12
---
--- >>> at 10 .~ Just "hello" $ HashMap.empty
--- fromList [(10,"hello")]
-at :: (Eq k, Hashable k) => k -> SimpleIndexedLens k (HashMap k v) (Maybe v)
-at k = index $ \f m -> (`go` m) <$> f k (HashMap.lookup k m) where
- go Nothing = HashMap.delete k
- go (Just v') = HashMap.insert k v'
-{-# INLINE at #-}
-
-- | Traversal of a 'HashMap' indexed by the key.
--
-- @'traverseMap' = 'index' 'traverseWithKey'@
traverseMap :: IndexedTraversal k (HashMap k v) (HashMap k v') v v'
traverseMap = index traverseWithKey
{-# INLINE traverseMap #-}
-
--- | Traverse the value at a given key in a 'HashMap'
-traverseAt :: (Eq k, Hashable k) => k -> SimpleIndexedTraversal k (HashMap k v) v
-traverseAt k = at k <. traverse
-{-# INLINE traverseAt #-}
View
16 src/Data/HashSet/Lens.hs
@@ -10,30 +10,16 @@
--
----------------------------------------------------------------------------
module Data.HashSet.Lens
- ( contains
- , setmapped
+ ( setmapped
, setOf
) where
-import Control.Applicative
import Control.Lens.Getter
import Control.Lens.Internal
import Control.Lens.Setter
-import Control.Lens.Type
import Data.HashSet as HashSet
import Data.Hashable
--- | This 'Lens' can be used to read, write or delete a member of a 'HashSet'
---
--- >>> :m + Data.HashSet Control.Lens
--- >>> contains 3 .~ False $ HashSet.fromList [1,2,3,4]
--- fromList [1,2,4]
-contains :: (Eq k, Hashable k) => k -> Simple Lens (HashSet k) Bool
-contains k f s = go <$> f (HashSet.member k s) where
- go False = HashSet.delete k s
- go True = HashSet.insert k s
-{-# INLINE contains #-}
-
-- | This 'Setter' can be used to change the type of a 'HashSet' by mapping
-- the elements to new values.
--
View
27 src/Data/IntMap/Lens.hs
@@ -13,9 +13,7 @@
--
----------------------------------------------------------------------------
module Data.IntMap.Lens
- ( at
- , traverseIntMap
- , traverseAt
+ ( traverseIntMap
, traverseAtMin
, traverseAtMax
) where
@@ -25,34 +23,11 @@ import Control.Lens
import Data.IntMap as IntMap
import Data.Traversable
--- | This 'Lens' can be used to read, write or delete the value associated with a key in an 'IntMap'.
---
--- >>> fromList [(1,"hello")] ^.at 1
--- Just "hello"
---
--- >>> at 1 .~ Just "hello" $ IntMap.empty
--- fromList [(1,"hello")]
---
--- > at :: Int -> (Maybe v -> f (Maybe v)) -> IntMap v -> f (IntMap v)
-at :: Int -> SimpleIndexedLens Int (IntMap v) (Maybe v)
-at k = index $ \ f m -> (`go` m) <$> f k (IntMap.lookup k m) where
- go Nothing = IntMap.delete k
- go (Just v') = IntMap.insert k v'
-{-# INLINE at #-}
-
-- | Traversal of an 'IntMap' indexed by the key.
traverseIntMap :: IndexedTraversal Int (IntMap v) (IntMap v') v v'
traverseIntMap = index $ \f -> sequenceA . mapWithKey f
{-# INLINE traverseIntMap #-}
--- | Traverse the value at a given key in an IntMap
---
--- > traverseAt :: Applicative f => Int -> (v -> f v) -> IntMap v -> f (IntMap v)
--- > traverseAt k = at k . traverse
-traverseAt :: Int -> SimpleIndexedTraversal Int (IntMap v) v
-traverseAt k = at k <. traverse
-{-# INLINE traverseAt #-}
-
-- | Traverse the value at the minimum key in a Map
--
-- The key of the minimum element is available as the index.
View
16 src/Data/IntSet/Lens.hs
@@ -10,29 +10,15 @@
--
----------------------------------------------------------------------------
module Data.IntSet.Lens
- ( contains
- , members
+ ( members
, setmapped
, setOf
) where
-import Control.Applicative
import Control.Lens
import Control.Lens.Internal
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 :: 'Functor' f => '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 #-}
-
-- | IntSet isn't Foldable, but this 'Fold' can be used to access the members of an 'IntSet'.
--
-- >>> sumOf members $ setOf folded [1,2,3,4]
View
31 src/Data/Map/Lens.hs
@@ -12,50 +12,21 @@
--
----------------------------------------------------------------------------
module Data.Map.Lens
- ( at
- , traverseMap
- , traverseAt
+ ( traverseMap
, traverseAtMin
, traverseAtMax
) where
import Control.Applicative as Applicative
-import Control.Lens.Traversal
import Control.Lens.Indexed
-import Control.Lens.IndexedLens
import Control.Lens.IndexedTraversal
import Data.Map as Map
import Data.Traversable
--- | This 'Lens' can be used to read, write or delete the value associated with a key in a 'Map'.
---
--- >>> :m + Control.Lens Data.Map.Lens
---
--- >>> Map.fromList [("hello",12)] ^.at "hello"
--- Just 12
---
--- >>> at 10 .~ Just "hello" $ Map.empty
--- fromList [(10,"hello")]
---
--- > at :: Ord k => k -> (Maybe v -> f (Maybe v)) -> Map k v -> f (Map k v)
-at :: Ord k => k -> SimpleIndexedLens k (Map k v) (Maybe v)
-at k = index $ \f m -> (`go` m) <$> f k (Map.lookup k m) where
- go Nothing = Map.delete k
- go (Just v') = Map.insert k v'
-{-# INLINE at #-}
-
-- | Traversal of a 'Map' indexed by the key.
traverseMap :: IndexedTraversal k (Map k v) (Map k v') v v'
traverseMap = index $ \f -> sequenceA . mapWithKey f
--- | Traverse the value at a given key in a Map
---
--- > traverseAt :: (Applicative f, Ord k) => k -> (v -> f v) -> Map k v -> f (Map k v)
--- > traverseAt k = valueAt k . traverse
-traverseAt :: Ord k => k -> SimpleIndexedTraversal k (Map k v) v
-traverseAt k = at k <. traverse
-{-# INLINE traverseAt #-}
-
-- | Traverse the value at the minimum key in a Map.
--
-- The key of the minimum element is available as the index of the traversal.
View
16 src/Data/Sequence/Lens.hs
@@ -11,7 +11,7 @@
--
----------------------------------------------------------------------------
module Data.Sequence.Lens
- ( at, viewL, viewR
+ ( ordinal, viewL, viewR
, traverseHead, traverseTail
, traverseLast, traverseInit
, traverseTo, traverseFrom
@@ -22,20 +22,18 @@ import Control.Applicative
import Control.Lens as Lens
import Data.Monoid
import Data.Sequence as Seq
-import Data.Traversable
-- | 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 -> SimpleIndexedLens Int (Seq a) a
-at i = Lens.index $ \ f m -> (\a -> update i a m) <$> f i (Seq.index m i)
+-- Note: This is only a legal lens if there is already such an element!
+ordinal :: Int -> SimpleIndexedLens Int (Seq a) a
+ordinal i = Lens.index $ \ f m -> (\a -> update i a m) <$> f i (Seq.index m i)
-- * Sequence isomorphisms
-- | A 'Seq' is isomorphic to a 'ViewL'
--
--- > viewl m = m^.viewL
+-- @'viewl' m = m '^.' 'viewL'@
viewL :: Iso (Seq a) (Seq b) (ViewL a) (ViewL b)
viewL = isos viewl unviewl viewl unviewl where
@@ -46,7 +44,7 @@ unviewl (a :< as) = a <| as
-- | A 'Seq' is isomorphic to a 'ViewR'
--
--- > viewr m = m^.viewR
+-- @'viewr' m = m '^.' 'viewR'@
viewR :: Iso (Seq a) (Seq b) (ViewR a) (ViewR b)
viewR = isos viewr unviewr viewr unviewr where
{-# INLINE viewR #-}
@@ -56,7 +54,7 @@ unviewr EmptyR = mempty
unviewr (as :> a) = as |> a
traverseSeq :: IndexedTraversal Int (Seq a) (Seq b) a b
-traverseSeq = Lens.index $ \ f -> sequenceA . Seq.mapWithIndex f
+traverseSeq = indexed traverse
{-# INLINE traverseSeq #-}
-- * Traversals
View
18 src/Data/Set/Lens.hs
@@ -10,31 +10,15 @@
--
----------------------------------------------------------------------------
module Data.Set.Lens
- ( contains
- , setmapped
+ ( setmapped
, setOf
) where
-import Control.Applicative
import Control.Lens.Getter
import Control.Lens.Internal
import Control.Lens.Setter
-import Control.Lens.Type
import Data.Set as Set
--- | This 'Lens' can be used to read, write or delete a member of a 'Set'
---
--- >>> :m + Data.Set.Lens Control.Lens
--- >>> contains 3 .~ False $ Set.fromList [1,2,3,4]
--- fromList [1,2,4]
---
--- > 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 'Setter' can be used to change the type of a 'Set' by mapping
-- the elements to new values.
--
View
2  src/Language/Haskell/TH/Lens.hs
@@ -29,8 +29,8 @@ import Control.Lens.Getter
import Control.Lens.Setter
import Control.Lens.Type
import Control.Lens.Traversal
+import Control.Lens.IndexedLens
import Data.Map as Map hiding (toList,map)
-import Data.Map.Lens
import Data.Maybe (fromMaybe)
import Data.Monoid
import Data.Set as Set hiding (toList,map)
Please sign in to comment.
Something went wrong with that request. Please try again.