This allow to work with sets using the standard lens mechanisms.

Also add a function that creates a lens where a setter function also
uses the information from a getter. This allows to optimize the setter,
in particular in the case of Set, keep the set unmodified, if the inner
function doesn't change anything.

Signed-off-by: Petr Pudlak <[email protected]>
---
 src/Ganeti/Lens.hs | 21 +++++++++++++++++++++
 1 file changed, 21 insertions(+)

diff --git a/src/Ganeti/Lens.hs b/src/Ganeti/Lens.hs
index 2373a8b..993bc7a 100644
--- a/src/Ganeti/Lens.hs
+++ b/src/Ganeti/Lens.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE RankNTypes #-}
+
 {-| Provides all lens-related functions.
 
 -}
@@ -25,17 +27,25 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, 
MA
 
 module Ganeti.Lens
   ( module Control.Lens
+  , lensWith
   , makeCustomLenses
   , makeCustomLenses'
   , traverseOf2
+  , atSet
   ) where
 
+import Control.Applicative ((<$>))
 import Control.Lens
 import Control.Monad
 import Data.Functor.Compose (Compose(..))
 import qualified Data.Set as S
 import Language.Haskell.TH
 
+-- | Creates an optimized lens where the setter also gets the original value
+-- from the getter.
+lensWith :: (s -> a) -> (s -> a -> b -> t) -> Lens s t a b
+lensWith sa sbt f s = uncurry (sbt s) <$> (\a -> fmap ((,) a) (f a)) (sa s)
+
 lensFieldName :: String -> String
 lensFieldName = (++ "L")
 
@@ -65,3 +75,14 @@ makeCustomLenses' name lst = makeCustomLensesFiltered f name
 traverseOf2 :: Over (->) (Compose f g) s t a b
             -> (a -> f (g b)) -> s -> f (g t)
 traverseOf2 k f = getCompose . traverseOf k (Compose . f)
+
+-- | A helper lens over sets.
+-- While a similar lens exists in the package (as @Lens' Set (Maybe ())@@),
+-- it's available only in most recent versions.
+-- And using @Bool@ instead of @Maybe ()@ is more convenient.
+atSet :: (Ord a) => a -> Lens' (S.Set a) Bool
+atSet k = lensWith (S.member k) f
+  where
+    f s True False = S.delete k s
+    f s False True = S.insert k s
+    f s _ _        = s
-- 
1.9.1.423.g4596e3a

Reply via email to