From 9336d0f32e0059f6d2721a2bc3b0585ea9e94c58 Mon Sep 17 00:00:00 2001
From: Edward Kmett <ekmett@gmail.com>
Date: Sun, 3 Feb 2013 16:31:46 -0500
Subject: [PATCH] Added `only` and `united`. Added `devoid` examples.

Conflicts:

	CHANGELOG.markdown
---
 CHANGELOG.markdown        |  3 ++-
 src/Control/Lens/Lens.hs  | 24 +++++++++++++++++++++++-
 src/Control/Lens/Prism.hs | 12 ++++++++++++
 3 files changed, 37 insertions(+), 2 deletions(-)

diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown
index 1fb2566d7..93ceef4cc 100644
--- 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
index 034dc4c43..0c5d874e0 100644
--- 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
index 70cebaa3c..eab276799 100644
--- 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 ==)