Added only and united. Added devoid examples.

Conflicts: CHANGELOG.markdown
ekmett · Feb 15, 2013 · 9336d0f · 9336d0f
1 parent b16ecd9
commit 9336d0f
Show file tree

Hide file tree

Showing 3 changed files with 37 additions and 2 deletions.
diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown
@@ -2,8 +2,9 @@
 -----
 * Fixed an issue with `DefaultSignatures` being used outside of the appropriate `#ifdef` that caused compilation issues on GHC 7.0.2.
 * Generalized the signature of `prism'`
-* Added `\_Void` to `Control.Lens.Prism` and `devoid` to `Control.Lens.Lens`.
+* Added `\_Void` and `only` to `Control.Lens.Prism` and `devoid` to `Control.Lens.Lens`.
 * Added `\_Nothing` to `Control.Lens.Prism`.
+* Added `devoid` and `united` to `Control.Lens.Lens`.
 
 3.8.5
 -----

diff --git a/src/Control/Lens/Lens.hs b/src/Control/Lens/Lens.hs
@@ -104,6 +104,7 @@ module Control.Lens.Lens
 
   -- * Common Lenses
   , devoid
+  , united
 
   -- * Context
   , Context(..)
@@ -938,6 +939,27 @@ l <#= b = do
 {-# INLINE (<#=) #-}
 
 -- | There is a field for every type in the 'Void'. Very zen.
-devoid :: Lens Void Void a b
+--
+-- >>> [] & mapped.devoid +~ 1
+-- []
+--
+-- Nothing & mapped.devoid %~ abs
+-- Nothing
+--
+-- @
+-- 'devoid' :: 'Lens'' 'Void' a
+-- @
+devoid :: Over p f Void Void a b
 devoid _ = absurd
 {-# INLINE devoid #-}
+
+-- | We can always retrieve a @()@ from any type.
+--
+-- >>> "hello"^.united
+-- ()
+--
+-- >>> "hello" & united .~ ()
+-- "hello"
+united :: Lens' a ()
+united f v = f () <&> \ () -> v
+{-# INLINE united #-}
diff --git a/src/Control/Lens/Prism.hs b/src/Control/Lens/Prism.hs
@@ -33,6 +33,7 @@ module Control.Lens.Prism
   , _Just
   , _Nothing
   , _Void
+  , only
   -- * Prismatic profunctors
   , Choice(..)
   ) where
@@ -42,6 +43,7 @@ import Control.Lens.Combinators
 import Control.Lens.Internal.Prism
 import Control.Lens.Internal.Setter
 import Control.Lens.Type
+import Control.Monad
 import Data.Bifunctor
 import Data.Profunctor
 import Data.Void
@@ -255,3 +257,13 @@ _Nothing = prism' (const Nothing) $ maybe (Just ()) (const Nothing)
 _Void :: Prism s s a Void
 _Void = prism absurd Left
 {-# INLINE _Void #-}
+
+-- | This 'Prism' compares for exact equality with a given value.
+--
+-- >>> only 4 # ()
+-- 4
+--
+-- >>> 5 ^? only 4
+-- Nothing
+only :: Eq a => a -> Prism' a ()
+only a = prism' (\() -> a) $ guard . (a ==)