[PATCH stable-2.12 02/11] Add a function for traversing over a composition of functors

['Petr Pudlak' via ganeti-devel]

Most often the inner functor is "(,) r" and "traverseOf2" is used to
traverse an effectful computation that also returns an additional
output value.

Signed-off-by: Petr Pudlak <pud...@google.com>
---
 src/Ganeti/Lens.hs         | 10 ++++++++++
 src/Ganeti/WConfd/Monad.hs |  5 ++---
 2 files changed, 12 insertions(+), 3 deletions(-)

diff --git a/src/Ganeti/Lens.hs b/src/Ganeti/Lens.hs
index 01df0fa..2373a8b 100644
--- a/src/Ganeti/Lens.hs
+++ b/src/Ganeti/Lens.hs
@@ -27,10 +27,12 @@ module Ganeti.Lens
   ( module Control.Lens
   , makeCustomLenses
   , makeCustomLenses'
+  , traverseOf2
   ) where
 
 import Control.Lens
 import Control.Monad
+import Data.Functor.Compose (Compose(..))
 import qualified Data.Set as S
 import Language.Haskell.TH
 
@@ -55,3 +57,11 @@ makeCustomLenses' name lst = makeCustomLensesFiltered f name
   where
     allowed = S.fromList . map nameBase $ lst
     f = flip S.member allowed
+
+-- | Traverses over a composition of two functors.
+-- Most often the @g@ functor is @(,) r@ and 'traverseOf2' is used to
+-- traverse an effectful computation that also returns an additional output
+-- value.
+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)
diff --git a/src/Ganeti/WConfd/Monad.hs b/src/Ganeti/WConfd/Monad.hs
index 8dd0d53..3e459a9 100644
--- a/src/Ganeti/WConfd/Monad.hs
+++ b/src/Ganeti/WConfd/Monad.hs
@@ -61,7 +61,6 @@ import Control.Monad.Error
 import Control.Monad.Reader
 import Control.Monad.State
 import Control.Monad.Trans.Control
-import Data.Functor.Compose (Compose(..))
 import Data.Functor.Identity
 import Data.IORef.Lifted
 import Data.Monoid (Any(..))
@@ -240,8 +239,8 @@ modifyTempResStateErr
 modifyTempResStateErr f = do
   -- we use Compose to traverse the composition of applicative functors
   -- @ErrorResult@ and @(,) a@
-  let f' ds = getCompose $ traverseOf dsTempResL
-              (Compose . runStateT (f (csConfigData . dsConfigState $ ds))) ds
+  let f' ds = traverseOf2 dsTempResL
+              (runStateT (f (csConfigData . dsConfigState $ ds))) ds
   dh <- daemonHandle
   toErrorBase $ atomicModifyIORefErr (dhDaemonState dh) (liftM swap . f')
 
-- 
1.9.1.423.g4596e3a