From 81543cbbbc41f178be487ac45386ef0e85595776 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sun, 21 Nov 2021 16:58:01 -0500
Subject: [PATCH] REF consolidate method call functions

---
 lib/XMonad/Internal/DBus/Brightness/Common.hs |  7 +--
 lib/XMonad/Internal/DBus/Common.hs            | 47 +++++++------------
 lib/XMonad/Internal/DBus/Screensaver.hs       |  7 +--
 lib/XMonad/Internal/Dependency.hs             |  2 +
 4 files changed, 28 insertions(+), 35 deletions(-)

diff --git a/lib/XMonad/Internal/DBus/Brightness/Common.hs b/lib/XMonad/Internal/DBus/Brightness/Common.hs
index 7f461d4..aafc29e 100644
--- a/lib/XMonad/Internal/DBus/Brightness/Common.hs
+++ b/lib/XMonad/Internal/DBus/Brightness/Common.hs
@@ -61,10 +61,11 @@ brightnessControls bc =
   where
     cb = callBacklight bc
 
+-- TODO not dry
 callGetBrightness :: Num c => BrightnessConfig a b -> IO (Maybe c)
 callGetBrightness BrightnessConfig { bcPath = p, bcInterface = i } = do
-  reply <- callMethod $ methodCall p i memGet
-  return $ reply >>= bodyGetBrightness
+  reply <- callMethod xmonadBus p i memGet
+  return $ either (const Nothing) bodyGetBrightness reply
 
 signalDep :: BrightnessConfig a b -> Dependency
 signalDep BrightnessConfig { bcPath = p, bcInterface = i } =
@@ -133,7 +134,7 @@ emitBrightness BrightnessConfig{ bcPath = p, bcInterface = i } client cur =
 callBacklight :: BrightnessConfig a b -> String -> MemberName -> FeatureIO
 callBacklight BrightnessConfig { bcPath = p, bcInterface = i, bcName = n } controlName m =
   Feature
-  { ftrMaybeAction = void $ callMethod $ methodCall p i m
+  { ftrMaybeAction = void $ callMethod xmonadBus p i m
   , ftrName = unwords [n, controlName]
   , ftrWarning = Default
   , ftrChildren = [xDbusDep p i $ Method_ m]
diff --git a/lib/XMonad/Internal/DBus/Common.hs b/lib/XMonad/Internal/DBus/Common.hs
index b4ca39b..861c2fe 100644
--- a/lib/XMonad/Internal/DBus/Common.hs
+++ b/lib/XMonad/Internal/DBus/Common.hs
@@ -2,9 +2,9 @@
 -- | Common internal DBus functions
 
 module XMonad.Internal.DBus.Common
-  ( callMethod
-  , callMethod'
-  , addMatchCallback
+  -- ( callMethod
+  -- , callMethod'
+  ( addMatchCallback
   , xmonadBus
   , xmonadBusName
   , xDbusDep
@@ -25,36 +25,25 @@ xmonadBus = Bus False xmonadBusName
 xDbusDep :: ObjectPath -> InterfaceName -> DBusMember -> Dependency
 xDbusDep o i m = DBusEndpoint xmonadBus $ Endpoint o i m
 
--- connectBus :: Bus -> IO (Maybe Client)
+-- -- | Call a method and return its result if successful
+-- callMethod :: MethodCall -> IO (Maybe [Variant])
+-- callMethod mc = do
+--   client <- connectSession
+--   r <- callMethod' client (Just xmonadBusName) mc
+--   disconnect client
+--   return r
 
--- | Call a method and return its result if successful
-callMethod :: MethodCall -> IO (Maybe [Variant])
-callMethod mc = do
-  client <- connectSession
-  r <- callMethod' client (Just xmonadBusName) mc
-  disconnect client
-  return r
-
-callMethod' :: Client -> Maybe BusName -> MethodCall -> IO (Maybe [Variant])
-callMethod' client bn mc = do
-  -- TODO handle clienterrors here
-  reply <- call client mc { methodCallDestination = bn }
-  -- TODO not all methods warrant that we wait for a reply? (see callNoReply)
-  return $ case reply of
-    Left _    -> Nothing
-    Right ret -> Just $ methodReturnBody ret
+-- callMethod' :: Client -> Maybe BusName -> MethodCall -> IO (Maybe [Variant])
+-- callMethod' client bn mc = do
+--   -- TODO handle clienterrors here
+--   reply <- call client mc { methodCallDestination = bn }
+--   -- TODO not all methods warrant that we wait for a reply? (see callNoReply)
+--   return $ case reply of
+--     Left _    -> Nothing
+--     Right ret -> Just $ methodReturnBody ret
 
 -- | Bind a callback to a signal match rule
 addMatchCallback :: MatchRule -> ([Variant] -> IO ()) -> IO SignalHandler
 addMatchCallback rule cb = do
   client <- connectSession
   addMatch client rule $ cb . signalBody
-
--- initControls :: Client -> (Client -> FeatureIO) -> (FeatureIO -> a) -> IO a
--- initControls client exporter controls = do
---   let x = exporter client
---   e <- evalFeature x
---   case e of
---     (Right c) -> c
---     _         -> return ()
---   return $ controls x
diff --git a/lib/XMonad/Internal/DBus/Screensaver.hs b/lib/XMonad/Internal/DBus/Screensaver.hs
index d272aa5..67c6dbd 100644
--- a/lib/XMonad/Internal/DBus/Screensaver.hs
+++ b/lib/XMonad/Internal/DBus/Screensaver.hs
@@ -128,12 +128,13 @@ callToggle = Feature
   , ftrChildren = [xDbusDep ssPath interface $ Method_ memToggle]
   }
   where
-    cmd = void $ callMethod $ methodCall ssPath interface memToggle
+    cmd = void $ callMethod xmonadBus ssPath interface memToggle
 
 callQuery :: IO (Maybe SSState)
 callQuery = do
-  reply <- callMethod $ methodCall ssPath interface memQuery
-  return $ reply >>= bodyGetCurrentState
+  reply <- callMethod xmonadBus ssPath interface memQuery
+  -- return $ reply >>= bodyGetCurrentState
+  return $ either (const Nothing) bodyGetCurrentState reply
 
 matchSignal :: (Maybe SSState -> IO ()) -> IO SignalHandler
 matchSignal cb = addMatchCallback ruleCurrentState $ cb . bodyGetCurrentState
diff --git a/lib/XMonad/Internal/Dependency.hs b/lib/XMonad/Internal/Dependency.hs
index 1836f21..40a99ac 100644
--- a/lib/XMonad/Internal/Dependency.hs
+++ b/lib/XMonad/Internal/Dependency.hs
@@ -30,6 +30,7 @@ module XMonad.Internal.Dependency
   , executeFeature_
   , applyFeature
   , applyFeature_
+  , callMethod
   ) where
 
 import           Control.Monad.IO.Class
@@ -243,6 +244,7 @@ introspectInterface = interfaceName_ "org.freedesktop.DBus.Introspectable"
 introspectMethod :: MemberName
 introspectMethod = memberName_ "Introspect"
 
+-- TODO this belongs somewhere else, IDK where tho for now
 callMethod :: Bus -> ObjectPath -> InterfaceName -> MemberName -> IO (Either String [Variant])
 callMethod (Bus usesys bus) path iface mem = do
   client <- if usesys then connectSystem else connectSession