ENH decouple dbus controls from exporter

bin/xmonad.hs

@@ -7,15 +7,18 @@
 module Main (main) where
 
 import           Control.Concurrent
-import           Control.Monad                                (unless)
+import           Control.Monad                                  (unless)
 
 import           Data.List
     ( isPrefixOf
     , sortBy
     , sortOn
     )
-import           Data.Maybe                                   (isJust, mapMaybe)
+import           Data.Maybe
-import           Data.Monoid                                  (All (..))
+    ( isJust
+    , mapMaybe
+    )
+import           Data.Monoid                                    (All (..))
 
 import           Graphics.X11.Types
 import           Graphics.X11.Xlib.Atom
@@ -45,35 +48,34 @@ import           XMonad.Internal.Concurrent.ClientMessage
 import           XMonad.Internal.Concurrent.DynamicWorkspaces
 import           XMonad.Internal.Concurrent.Removable
 import           XMonad.Internal.DBus.Brightness.Common
+import           XMonad.Internal.DBus.Brightness.IntelBacklight
 import           XMonad.Internal.DBus.Control
 import           XMonad.Internal.DBus.Screensaver
 import           XMonad.Internal.Dependency
 import           XMonad.Internal.Process
 import           XMonad.Internal.Shell
-import qualified XMonad.Internal.Theme                        as T
+import qualified XMonad.Internal.Theme                          as T
 import           XMonad.Layout.MultiToggle
 import           XMonad.Layout.NoBorders
 import           XMonad.Layout.NoFrillsDecoration
 import           XMonad.Layout.PerWorkspace
 import           XMonad.Layout.Renamed
 import           XMonad.Layout.Tabbed
-import qualified XMonad.Operations                            as O
+import qualified XMonad.Operations                              as O
-import qualified XMonad.StackSet                              as W
+import qualified XMonad.StackSet                                as W
 import           XMonad.Util.Cursor
 import           XMonad.Util.EZConfig
-import qualified XMonad.Util.ExtensibleState                  as E
+import qualified XMonad.Util.ExtensibleState                    as E
 import           XMonad.Util.NamedActions
 import           XMonad.Util.WorkspaceCompare
 
 main :: IO ()
 main = do
-  DBusXMonad
+  cl <- startXMonadService
-    { dxClient = cl
-    , dxIntelBacklightCtrl = bc
-    , dxScreensaverCtrl = sc
-    } <- startXMonadService
   (h, p) <- spawnPipe "xmobar"
+  dbusActions <- mapM evalFeature [exportScreensaver cl, exportIntelBacklight cl]
   depActions <- mapM evalFeature [runPowermon, runRemovableMon]
+  mapM_ whenInstalled dbusActions
   mapM_ (mapM_ forkIO) depActions
   _ <- forkIO $ runWorkspaceMon allDWs
   let ts = ThreadState
@@ -82,8 +84,8 @@ main = do
         , childHandles = [h]
         }
   lock <- whenInstalled <$> evalFeature runScreenLock
-  ext <- evalExternal $ externalBindings bc sc ts lock
+  ext <- evalExternal $ externalBindings ts lock
-  warnMissing $ externalToMissing ext ++ fmap (io <$>) depActions
+  warnMissing $ externalToMissing ext ++ fmap (io <$>) (depActions ++ dbusActions)
   -- IDK why this is necessary; nothing prior to this line will print if missing
   hFlush stdout
   launch
@@ -496,9 +498,8 @@ flagKeyBinding k@KeyBinding{ kbDesc = d, kbAction = a } = case a of
   (Right x) -> Just $ k{ kbAction = x }
   (Left _)  -> Just $ k{ kbDesc = "[!!!]" ++  d, kbAction = skip }
 
-externalBindings :: BrightnessControls -> SSControls -> ThreadState -> X ()
+externalBindings :: ThreadState -> X () -> [KeyGroup FeatureX]
-  -> [KeyGroup FeatureX]
+externalBindings ts lock =
-externalBindings bc sc ts lock =
   [ KeyGroup "Launchers"
     [ KeyBinding "<XF86Search>" "select/launch app" runAppMenu
     , KeyBinding "M-g" "launch clipboard manager" runClipMenu
@@ -543,10 +544,10 @@ externalBindings bc sc ts lock =
     ]
 
   , KeyGroup "System"
-    [ KeyBinding "M-." "backlight up" $ ioFeature $ bctlInc bc
+    [ KeyBinding "M-." "backlight up" $ ioFeature $ bctlInc intelBacklightControls
-    , KeyBinding "M-," "backlight down" $ ioFeature $ bctlDec bc
+    , KeyBinding "M-," "backlight down" $ ioFeature $ bctlDec intelBacklightControls
-    , KeyBinding "M-M1-," "backlight min" $ ioFeature $ bctlMin bc
+    , KeyBinding "M-M1-," "backlight min" $ ioFeature $ bctlMin intelBacklightControls
-    , KeyBinding "M-M1-." "backlight max" $ ioFeature $ bctlMax bc
+    , KeyBinding "M-M1-." "backlight max" $ ioFeature $ bctlMax intelBacklightControls
     , KeyBinding "M-<End>" "power menu" $ ConstFeature $ runPowerPrompt lock
     , KeyBinding "M-<Home>" "quit xmonad" $ ConstFeature runQuitPrompt
     , KeyBinding "M-<Delete>" "lock screen" runScreenLock
@@ -558,7 +559,7 @@ externalBindings bc sc ts lock =
     , KeyBinding "M-<F8>" "select autorandr profile" runAutorandrMenu
     , KeyBinding "M-<F9>" "toggle ethernet" runToggleEthernet
     , KeyBinding "M-<F10>" "toggle bluetooth" runToggleBluetooth
-    , KeyBinding "M-<F11>" "toggle screensaver" $ ioFeature $ ssToggle sc
+    , KeyBinding "M-<F11>" "toggle screensaver" $ ioFeature callToggle
     , KeyBinding "M-<F12>" "switch gpu" runOptimusPrompt
     ]
   ]

lib/XMonad/Internal/DBus/Brightness/Common.hs

@@ -4,7 +4,8 @@
 module XMonad.Internal.DBus.Brightness.Common
   ( BrightnessConfig(..)
   , BrightnessControls(..)
-  , exportBrightnessControls
+  , brightnessControls
+  , brightnessExporter
   , callGetBrightness
   , matchSignal
   ) where
@@ -45,18 +46,16 @@ data BrightnessControls = BrightnessControls
   , bctlDec :: FeatureIO
   }
 
-exportBrightnessControls :: RealFrac b => [Dependency] -> BrightnessConfig a b
+brightnessControls :: BrightnessConfig a b -> BrightnessControls
-  -> Client -> IO BrightnessControls
+brightnessControls BrightnessConfig { bcPath = p, bcInterface = i } =
-exportBrightnessControls deps bc client =
+  BrightnessControls
-  initControls client (brightnessExporter deps bc) controls
+  { bctlMax = cb memMax
+  , bctlMin = cb memMin
+  , bctlInc = cb memInc
+  , bctlDec = cb memDec
+  }
   where
-    controls _ = let callBacklight' = callBacklight bc in
+    cb = callBacklight p i
-      BrightnessControls
-        { bctlMax = callBacklight' memMax
-        , bctlMin = callBacklight' memMin
-        , bctlInc = callBacklight' memInc
-        , bctlDec = callBacklight' memDec
-        }
 
 callGetBrightness :: Num c => BrightnessConfig a b -> IO (Maybe c)
 callGetBrightness BrightnessConfig { bcPath = p, bcInterface = i } = do
@@ -77,24 +76,8 @@ matchSignal BrightnessConfig { bcPath = p, bcInterface = i } cb = do
 --------------------------------------------------------------------------------
 -- | Internal DBus Crap
 
--- exportBrightnessControls' :: RealFrac b => BrightnessConfig a b -> Client -> IO ()
+brightnessExporter :: RealFrac b => [Dependency] -> BrightnessConfig a b
--- exportBrightnessControls' bc client = do
+  -> Client -> FeatureIO
---   maxval <- bcGetMax bc -- assume the max value will never change
---   let autoMethod' m f = autoMethod m $ emitBrightness bc client =<< f bc maxval
---   let funget = bcGet bc
---   export client (bcPath bc) defaultInterface
---     { interfaceName = bcInterface bc
---     , interfaceMethods =
---       [ autoMethod' memMax bcMax
---       , autoMethod' memMin bcMin
---       , autoMethod' memInc bcInc
---       , autoMethod' memDec bcDec
---       , autoMethod memGet (round <$> funget maxval :: IO Int32)
---       ]
---     }
-
-brightnessExporter :: RealFrac b => [Dependency]
-  -> BrightnessConfig a b -> Client -> FeatureIO
 brightnessExporter deps bc client = Feature
   { ftrAction = exportBrightnessControls' bc client
   , ftrSilent = False
@@ -123,19 +106,13 @@ emitBrightness BrightnessConfig{ bcPath = p, bcInterface = i } client cur =
   where
     sig = signal p i memCur
 
--- callBacklight :: BrightnessConfig a b -> MemberName -> IO ()
+callBacklight :: ObjectPath -> InterfaceName -> MemberName -> FeatureIO
--- callBacklight BrightnessConfig { bcPath = p, bcInterface = i } mem =
+callBacklight p  i m =
---   void $ callMethod $ methodCall p i mem
-
-callBacklight :: BrightnessConfig a b -> MemberName -> FeatureIO
-callBacklight BrightnessConfig { bcPath = p, bcInterface = i } mem =
   Feature
-  { ftrAction = void $ callMethod $ methodCall p i mem
+  { ftrAction = void $ callMethod $ methodCall p i m
   , ftrSilent = False
-  , ftrChildren = [mkDep mem]
+  , ftrChildren = [xDbusDep p i $ Method_ m]
   }
-  where
-    mkDep = xDbusDep p i . Method_
 
 bodyGetBrightness :: Num a => [Variant] -> Maybe a
 bodyGetBrightness [b] = fromIntegral <$> (fromVariant b :: Maybe Int32)

lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs

@@ -5,6 +5,7 @@ module XMonad.Internal.DBus.Brightness.IntelBacklight
   ( callGetBrightnessIB
   , matchSignalIB
   , exportIntelBacklight
+  , intelBacklightControls
   , curFileDep
   , maxFileDep
   , blPath
@@ -88,9 +89,12 @@ curFileDep = pathRW curFile
 maxFileDep :: Dependency
 maxFileDep = pathR maxFile
 
-exportIntelBacklight :: Client -> IO BrightnessControls
+exportIntelBacklight :: Client -> FeatureIO
 exportIntelBacklight =
-  exportBrightnessControls [curFileDep, maxFileDep] intelBacklightConfig
+  brightnessExporter [curFileDep, maxFileDep] intelBacklightConfig
+
+intelBacklightControls :: BrightnessControls
+intelBacklightControls = brightnessControls intelBacklightConfig
 
 callGetBrightnessIB :: IO (Maybe Brightness)
 callGetBrightnessIB = callGetBrightness intelBacklightConfig

lib/XMonad/Internal/DBus/Control.hs

@@ -18,10 +18,10 @@ import           DBus
 import           DBus.Client
 
 import           XMonad.Internal.DBus.Brightness.Common
-import           XMonad.Internal.DBus.Brightness.IntelBacklight
+-- import           XMonad.Internal.DBus.Brightness.IntelBacklight
 import           XMonad.Internal.DBus.Common
 import           XMonad.Internal.DBus.Screensaver
-import           XMonad.Internal.Dependency
+-- import           XMonad.Internal.Dependency
 
 introspectInterface :: InterfaceName
 introspectInterface = interfaceName_ "org.freedesktop.DBus.Introspectable"
@@ -36,37 +36,47 @@ data DBusXMonad = DBusXMonad
   , dxScreensaverCtrl    :: SSControls
   }
 
-blankControls :: BrightnessControls
+-- blankControls :: BrightnessControls
-blankControls = BrightnessControls
+-- blankControls = BrightnessControls
-  { bctlMax = BlankFeature
+--   { bctlMax = BlankFeature
-  , bctlMin = BlankFeature
+--   , bctlMin = BlankFeature
-  , bctlInc = BlankFeature
+--   , bctlInc = BlankFeature
-  , bctlDec = BlankFeature
+--   , bctlDec = BlankFeature
-  }
+--   }
 
-blankSSToggle :: SSControls
+-- blankSSToggle :: SSControls
-blankSSToggle = SSControls { ssToggle = BlankFeature }
+-- blankSSToggle = SSControls { ssToggle = BlankFeature }
 
-startXMonadService :: IO DBusXMonad
+-- xmonadService :: Feature (IO Client)
+-- xmonadService = Feature
+--   { ftrAction = undefined
+--   , ftr
+
+
+startXMonadService :: IO Client
 startXMonadService = do
   client <- connectSession
-  requestResult <- requestName client xmonadBus []
+  res <- requestName client xmonadBus []
+  case res of
+    NamePrimaryOwner -> return ()
+    _                -> putStrLn $ "error when requesting '" ++ formatBusName xmonadBus ++ "'"
   -- TODO if the client is not released on shutdown the owner will be
   -- different
-  (i, s) <- if requestResult /= NamePrimaryOwner then do
+  -- (i, s) <- if requestResult /= NamePrimaryOwner then do
-    putStrLn "Another service owns \"org.xmonad\""
+  --   putStrLn "Another service owns \"org.xmonad\""
-    return (blankControls, blankSSToggle)
+  --   return (blankControls, blankSSToggle)
-    else do
+  --   else do
-    putStrLn "Started xmonad dbus client"
+  --   putStrLn "Started xmonad dbus client"
-    bc <- exportIntelBacklight client
+  --   bc <- exportIntelBacklight client
-    sc <- exportScreensaver client
+  --   sc <- exportScreensaver client
-    return (bc, sc)
+  --   return (bc, sc)
-  return $ DBusXMonad
+  return client
-    { dxClient = client
+  -- return $ DBusXMonad
-    , dxIntelBacklightCtrl = i
+  --   { dxClient = client
-    -- , dxClevoBacklightCtrl = c
+  --   , dxIntelBacklightCtrl = i
-    , dxScreensaverCtrl = s
+  --   -- , dxClevoBacklightCtrl = c
-    }
+  --   , dxScreensaverCtrl = s
+  --   }
 
 stopXMonadService :: Client -> IO ()
 stopXMonadService client = do

lib/XMonad/Internal/DBus/Screensaver.hs

@@ -99,13 +99,13 @@ bodyGetCurrentState _   = Nothing
 
 newtype SSControls = SSControls { ssToggle :: FeatureIO }
 
-exportScreensaver :: Client -> IO SSControls
+-- exportScreensaver :: Client -> IO SSControls
-exportScreensaver client = initControls client exportScreensaver' controls
+-- exportScreensaver client = initControls client exportScreensaver' controls
-  where
+--   where
-    controls _ = SSControls { ssToggle = callToggle }
+--     controls _ = SSControls { ssToggle = callToggle }
 
-exportScreensaver' :: Client -> FeatureIO
+exportScreensaver :: Client -> FeatureIO
-exportScreensaver' client = Feature
+exportScreensaver client = Feature
   { ftrAction = cmd
   , ftrSilent = False
   , ftrChildren = [ssDep]
@@ -123,11 +123,10 @@ callToggle :: FeatureIO
 callToggle = Feature
   { ftrAction = cmd
   , ftrSilent = False
-  , ftrChildren = mkDep <$> [memQuery, memState, memToggle]
+  , ftrChildren = [xDbusDep ssPath interface $ Method_ memToggle]
   }
   where
     cmd = void $ callMethod $ methodCall ssPath interface memToggle
-    mkDep = xDbusDep ssPath interface . Method_
 
 callQuery :: IO (Maybe SSState)
 callQuery = do

lib/XMonad/Internal/Dependency.hs

@@ -55,7 +55,6 @@ data DBusMember = Method_ MemberName
   | Property_ String
   deriving (Eq, Show)
 
--- data DependencyData = Executable String
 data Dependency = Executable String
   | AccessiblePath FilePath Bool Bool
   | IOTest (IO (Maybe String))
@@ -68,9 +67,6 @@ data Dependency = Executable String
     }
   | Systemd UnitType String
 
--- data Dependency a = SubFeature (Feature a a)
---   | Dependency DependencyData
-
 data Feature a = Feature
   { ftrAction   :: a
   , ftrSilent   :: Bool
@@ -102,17 +98,14 @@ evalFeature Feature { ftrAction = a, ftrSilent = s, ftrChildren = c } = do
 exe :: String -> Dependency
 exe = Executable
 
-path :: Bool -> Bool -> String -> Dependency
-path r w n = AccessiblePath n r w
-
 pathR :: String -> Dependency
-pathR = path True False
+pathR n = AccessiblePath n True False
 
 pathW :: String -> Dependency
-pathW = path False True
+pathW n = AccessiblePath n False True
 
 pathRW :: String -> Dependency
-pathRW = path True True
+pathRW n = AccessiblePath n True True
 
 systemUnit :: String -> Dependency
 systemUnit = Systemd SystemUnit