Permalink
Browse files

Added `only` and `united`. Added `devoid` examples.

Conflicts:

	CHANGELOG.markdown
  • Loading branch information...
1 parent b16ecd9 commit 9336d0f32e0059f6d2721a2bc3b0585ea9e94c58 @ekmett committed Feb 3, 2013
Showing with 37 additions and 2 deletions.
  1. +2 −1 CHANGELOG.markdown
  2. +23 −1 src/Control/Lens/Lens.hs
  3. +12 −0 src/Control/Lens/Prism.hs
View
@@ -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
-----
View
@@ -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 #-}
View
@@ -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 ==)

0 comments on commit 9336d0f

Please sign in to comment.