ENH standardize export/unexport pairs

lib/Data/Internal/DBus.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 --------------------------------------------------------------------------------
 -- Common internal DBus functions
 
@@ -25,6 +27,7 @@ module Data.Internal.DBus
   , addInterfaceRemovedListener
   , fromSingletonVariant
   , bodyToMaybe
+  , exportPair
   )
 where
 
@@ -302,3 +305,24 @@ addInterfaceRemovedListener
   -> m (Maybe SignalHandler)
 addInterfaceRemovedListener bus =
   addInterfaceChangedListener bus omInterfacesRemoved
+
+--------------------------------------------------------------------------------
+-- Interface export/unexport
+
+exportPair
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, SafeClient c)
+  => ObjectPath
+  -> (Client -> m Interface)
+  -> c
+  -> (m (), m ())
+exportPair path toIface cl = (up, down)
+  where
+    cl_ = toClient cl
+    up = do
+      logInfo $ "adding interface: " <> path_
+      i <- toIface cl_
+      liftIO $ export cl_ path i
+    down = do
+      logInfo $ "removing interface: " <> path_
+      liftIO $ unexport cl_ path
+    path_ = Utf8Builder $ encodeUtf8Builder $ T.pack $ formatObjectPath path

lib/XMonad/Internal/DBus/Screensaver.hs

@@ -98,25 +98,19 @@ exportScreensaver
   => Maybe SesClient
   -> Sometimes (m (), m ())
 exportScreensaver ses =
-  sometimesDBus ses "screensaver toggle" "xset" (toAnd_ bus ssx) $ \cl -> (up cl, down cl)
+  sometimesDBus ses "screensaver toggle" "xset" (toAnd_ bus ssx) cmd
   where
-    up cl =
+    cmd = exportPair ssPath $ \cl_ -> do
-      let cl' = toClient cl
+      liftIO $ withRunInIO $ \run ->
-       in liftIO $ withRunInIO $ \run ->
+        return $
-            export
+          defaultInterface
-              cl'
+            { interfaceName = interface
-              ssPath
+            , interfaceMethods =
-              defaultInterface
+                [ autoMethod memToggle $ run $ emitState cl_ =<< toggle
-                { interfaceName = interface
+                , autoMethod memQuery (run query)
-                , interfaceMethods =
+                ]
-                    [ autoMethod memToggle $ run $ emitState cl' =<< toggle
+            , interfaceSignals = [sig]
-                    , autoMethod memQuery (run query)
+            }
-                    ]
-                , interfaceSignals = [sig]
-                }
-    down cl = do
-      logInfo "removing screensaver interface"
-      liftIO $ unexport (toClient cl) ssPath
     sig =
       I.Signal
         { I.signalName = memState