add getAll and relax type of modify to allow use with traversals

source/Network/Xmpp/Lens.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE RankNTypes #-}
@@ -5,9 +6,9 @@
 {-# LANGUAGE FunctionalDependencies #-}
 
 -- | Van Laarhoven lenses for XMPP types. The lenses are designed to work with
--- the lens library. This module also provides 3 simple accessors ('view',
+-- the lens library. This module also provides a few simple accessors ('view',
--- 'modify', 'set') so you don't need to pull in the lens library to get some
+-- 'modify', 'set' and 'getAll') so you don't need to pull in the
--- use out of them.
+-- lens library to get some use out of them.
 --
 -- The name of the lenses corresponds to the field name of the data types with
 -- an upper-case L appended. For documentation of the fields refer to the documentation of the data types (linked in the section header)
@@ -18,12 +19,15 @@ module Network.Xmpp.Lens
          -- * Accessors
          -- | Reimplementation of the basic lens functions so you don't have to
          -- bring in all of lens library in to use the lenses
+
+         -- ** Lenses
        , view
        , modify
        , set
+         -- * Traversals
+       , getAll
          -- * Lenses
 
-
          -- ** Stanzas
        , IsStanza(..)
        , HasStanzaPayload(..)
@@ -113,6 +117,37 @@ type Lens a b = Functor f => (b -> f b) -> a -> f a
 
 type Traversal a b = Applicative f => (b -> f b) -> a -> f a
 
+
+-- Accessors
+---------------
+
+
+-- | Read the value the lens is pointing to
+view :: Lens a b -> a -> b
+view l x = getConst $ l Const x
+
+-- | Replace the value the lens is pointing to
+set :: Lens a b -> b -> a -> a
+set l b x = modify l (const b) x
+
+-- | modify the Value(s) a Lens or Traversal is pointing to
+modify :: Traversal a b -> (b -> b) -> a -> a
+modify t f = runIdentity . t (Identity . f)
+
+newtype Collect a b = Collect {getCollection :: [a]} deriving Functor
+
+instance Applicative (Collect a) where
+    pure _ = Collect []
+    Collect xs <*> Collect ys = Collect $ xs ++ ys
+
+-- | Return all the values a Traversal is pointing to in a list
+getAll :: Traversal a b -> a -> [b]
+getAll t = getCollection . t (Collect . pure)
+
+
+-- Xmpp Lenses
+--------------------
+
 class IsStanza s where
     -- | From-attribute of the stanza
     from :: Lens s (Maybe Jid)
@@ -381,19 +416,6 @@ pluginsL :: Lens SessionConfiguration [Plugin]
 pluginsL inj sc@SessionConfiguration{plugins = x}
     = (\x' -> sc{plugins = x'}) <$> inj x
 
--- | Read the value the lens is pointing to
-view :: Lens a b -> a -> b
-view l x = getConst $ l Const x
-
--- | Modify the value the lens is pointing to
-modify :: Lens a b -> (b -> b) -> a -> a
-modify l f x = runIdentity $ l (fmap f . Identity) x
-
--- | Replace the value the lens is pointing to
-set :: Lens a b -> b -> a -> a
-set l b x = modify l (const b) x
-
-
 -- Roster
 ------------------