REF move dependency interface to own module/pull common code from intelbacklight

bin/xmobar.hs

@@ -21,7 +21,9 @@ import           System.Directory
 import           System.Exit
 import           System.IO
 import           System.IO.Error
-import           System.Process                      (readProcessWithExitCode)
+import           System.Process
+    ( readProcessWithExitCode
+    )
 
 import           Xmobar.Plugins.Bluetooth
 import           Xmobar.Plugins.ClevoKeyboard
@@ -30,15 +32,18 @@ import           Xmobar.Plugins.IntelBacklight
 import           Xmobar.Plugins.Screensaver
 import           Xmobar.Plugins.VPN
 
-import           XMonad                              (getXMonadDir)
+import           XMonad                                         (getXMonadDir)
-import           XMonad.Hooks.DynamicLog             (wrap, xmobarColor)
+import           XMonad.Hooks.DynamicLog
-import           XMonad.Internal.Command.Power       (hasBattery)
+    ( wrap
-import           XMonad.Internal.DBus.Common         (xmonadBus)
+    , xmobarColor
-import           XMonad.Internal.DBus.Control        (pathExists)
+    )
-import           XMonad.Internal.DBus.IntelBacklight (blPath)
+import           XMonad.Internal.Command.Power                  (hasBattery)
-import           XMonad.Internal.DBus.Screensaver    (ssPath)
+import           XMonad.Internal.DBus.Brightness.IntelBacklight (blPath)
-import           XMonad.Internal.Shell               (fmtCmd)
+import           XMonad.Internal.DBus.Common                    (xmonadBus)
-import qualified XMonad.Internal.Theme               as T
+import           XMonad.Internal.DBus.Control                   (pathExists)
+import           XMonad.Internal.DBus.Screensaver               (ssPath)
+import           XMonad.Internal.Shell                          (fmtCmd)
+import qualified XMonad.Internal.Theme                          as T
 import           Xmobar
 
 main :: IO ()

bin/xmonad.hs

@@ -44,9 +44,10 @@ import           XMonad.Internal.Concurrent.ACPIEvent
 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.Control
-import           XMonad.Internal.DBus.IntelBacklight
 import           XMonad.Internal.DBus.Screensaver
+import           XMonad.Internal.Dependency
 import           XMonad.Internal.Process
 import           XMonad.Internal.Shell
 import qualified XMonad.Internal.Theme                        as T
@@ -66,7 +67,11 @@ import           XMonad.Util.WorkspaceCompare
 
 main :: IO ()
 main = do
-  (cl, bc, sc) <- startXMonadService
+  DBusXMonad
+    { dxClient = cl
+    , dxIntelBacklightCtrl = bc
+    , dxScreensaverCtrl = sc
+    } <- startXMonadService
   (h, p) <- spawnPipe "xmobar"
   _ <- forkIO runPowermon
   _ <- forkIO runRemovableMon
@@ -485,7 +490,7 @@ filterExternal kgs = let kgs' = fmap go kgs in (fst <$> kgs', concatMap snd kgs'
       Ignore         -> (Nothing, [])
     flagMissing s = "[!!!]" ++ s
 
-externalBindings :: Maybe BacklightControls
+externalBindings :: Maybe BrightnessControls
   -> MaybeExe SSControls
   -> ThreadState
   -> [KeyGroup (IO MaybeX)]
@@ -534,10 +539,10 @@ externalBindings bc sc ts =
     ]
 
   , KeyGroup "System"
-    [ KeyBinding "M-." "backlight up" $ runMaybe bc backlightUp
+    [ KeyBinding "M-." "backlight up" $ runMaybe bc bctlInc
-    , KeyBinding "M-," "backlight down" $ runMaybe bc backlightDown
+    , KeyBinding "M-," "backlight down" $ runMaybe bc bctlDec
-    , KeyBinding "M-M1-," "backlight min" $ runMaybe bc backlightMin
+    , KeyBinding "M-M1-," "backlight min" $ runMaybe bc bctlMin
-    , KeyBinding "M-M1-." "backlight max" $ runMaybe bc backlightMax
+    , KeyBinding "M-M1-." "backlight max" $ runMaybe bc bctlMax
     , KeyBinding "M-<End>" "power menu" $ noCheck runPowerPrompt
     , KeyBinding "M-<Home>" "quit xmonad" $ noCheck runQuitPrompt
     , KeyBinding "M-<Delete>" "lock screen" runScreenLock

lib/XMonad/Internal/Command/DMenu.hs

@@ -17,13 +17,13 @@ import           Control.Monad.Reader
 
 import           Graphics.X11.Types
 
-import           System.Directory         (XdgDirectory (..), getXdgDirectory)
+import           System.Directory           (XdgDirectory (..), getXdgDirectory)
 import           System.IO
 
-import           XMonad.Core              hiding (spawn)
+import           XMonad.Core                hiding (spawn)
+import           XMonad.Internal.Dependency
 import           XMonad.Internal.Notify
 import           XMonad.Internal.Process
-import           XMonad.Internal.Shell
 import           XMonad.Util.NamedActions
 
 --------------------------------------------------------------------------------

lib/XMonad/Internal/Command/Desktop.hs

@@ -45,9 +45,9 @@ import           System.FilePath
 import           XMonad.Actions.Volume
 import           XMonad.Core                      hiding (spawn)
 import           XMonad.Internal.DBus.Screensaver
+import           XMonad.Internal.Dependency
 import           XMonad.Internal.Notify
 import           XMonad.Internal.Process
-import           XMonad.Internal.Shell
 import           XMonad.Operations
 
 --------------------------------------------------------------------------------

lib/XMonad/Internal/Command/Power.hs

@@ -28,8 +28,8 @@ import           System.IO.Error
 import           System.Process
 
 import           XMonad.Core
+import           XMonad.Internal.Dependency
 import           XMonad.Internal.Process     (readCreateProcessWithExitCode')
-import           XMonad.Internal.Shell
 import qualified XMonad.Internal.Theme       as T
 import           XMonad.Prompt
 import           XMonad.Prompt.ConfirmPrompt

lib/XMonad/Internal/Concurrent/ACPIEvent.hs

@@ -25,7 +25,7 @@ import           System.IO.Streams.UnixSocket
 import           XMonad.Core
 import           XMonad.Internal.Command.Power
 import           XMonad.Internal.Concurrent.ClientMessage
-import           XMonad.Internal.Shell
+import           XMonad.Internal.Dependency
 
 --------------------------------------------------------------------------------
 -- | Data structure to hold the ACPI events I care about

lib/XMonad/Internal/Concurrent/Removable.hs

@@ -15,7 +15,7 @@ import           DBus
 import           DBus.Client
 
 import           XMonad.Internal.DBus.Control (pathExists)
-import           XMonad.Internal.Shell
+import           XMonad.Internal.Dependency
 
 bus :: BusName
 bus = busName_ "org.freedesktop.UDisks2"

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

@@ -0,0 +1,128 @@
+--------------------------------------------------------------------------------
+-- | DBus module for DBus brightness controls
+
+module XMonad.Internal.DBus.Brightness.Common
+  ( BrightnessConfig(..)
+  , BrightnessControls(..)
+  , exportBrightnessControls
+  , callGetBrightness
+  , matchSignal
+  ) where
+
+import           Control.Monad               (void)
+
+import           Data.Int                    (Int32)
+
+import           DBus
+import           DBus.Client
+
+import           XMonad.Internal.DBus.Common
+
+--------------------------------------------------------------------------------
+-- | External API
+--
+-- Define four methods to increase, decrease, maximize, or minimize the
+-- brightness. These methods will all return the current brightness as a 32-bit
+-- integer and emit a signal with the same brightness value. Additionally, there
+-- is one method to get the current brightness.
+
+data BrightnessConfig a b = BrightnessConfig
+  { bcMin       :: a -> IO b
+  , bcMax       :: a -> IO b
+  , bcDec       :: a -> IO b
+  , bcInc       :: a -> IO b
+  , bcGet       :: a -> IO b
+  , bcGetMax    :: IO a
+  , bcPath      :: ObjectPath
+  , bcInterface :: InterfaceName
+  }
+
+data BrightnessControls = BrightnessControls
+  { bctlMax :: IO ()
+  , bctlMin :: IO ()
+  , bctlInc :: IO ()
+  , bctlDec :: IO ()
+  }
+
+exportBrightnessControls :: RealFrac b => BrightnessConfig a b -> Client
+  -> IO BrightnessControls
+exportBrightnessControls bc client = do
+  exportBrightnessControls' bc client
+  return $ BrightnessControls
+    { bctlMax = callBacklight' memMax
+    , bctlMin = callBacklight' memMin
+    , bctlInc = callBacklight' memInc
+    , bctlDec = callBacklight' memDec
+    }
+  where
+    callBacklight' = callBacklight bc
+
+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
+
+matchSignal :: Num c => BrightnessConfig a b -> (Maybe c -> IO ()) -> IO SignalHandler
+matchSignal BrightnessConfig { bcPath = p, bcInterface = i } cb = do
+  client <- connectSession
+  addMatch client brMatcher $ cb . bodyGetBrightness . signalBody
+  where
+    brMatcher = matchAny
+      { matchPath = Just p
+      , matchInterface = Just i
+      , matchMember = Just memCur
+      }
+
+--------------------------------------------------------------------------------
+-- | Internal DBus Crap
+
+exportBrightnessControls' :: RealFrac b => BrightnessConfig a b -> Client -> IO ()
+exportBrightnessControls' bc client = do
+  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)
+      ]
+    }
+
+emitBrightness :: RealFrac b => BrightnessConfig a b -> Client -> b -> IO ()
+emitBrightness BrightnessConfig{ bcPath = p, bcInterface = i } client cur =
+  emit client $ sig { signalBody = [toVariant (round cur :: Int32)] }
+  where
+    sig = signal p i memCur
+
+callBacklight :: BrightnessConfig a b -> MemberName -> IO ()
+callBacklight BrightnessConfig { bcPath = p, bcInterface = i } mem =
+  void $ callMethod $ methodCall p i mem
+
+bodyGetBrightness :: Num a => [Variant] -> Maybe a
+bodyGetBrightness [b] = fromIntegral <$> (fromVariant b :: Maybe Int32)
+bodyGetBrightness _   = Nothing
+
+--------------------------------------------------------------------------------
+-- | DBus Members
+
+memCur :: MemberName
+memCur = memberName_ "CurrentBrightness"
+
+memGet :: MemberName
+memGet = memberName_ "GetBrightness"
+
+memMax :: MemberName
+memMax = memberName_ "MaxBrightness"
+
+memMin :: MemberName
+memMin = memberName_ "MinBrightness"
+
+memInc :: MemberName
+memInc = memberName_ "IncBrightness"
+
+memDec :: MemberName
+memDec = memberName_ "DecBrightness"

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

@@ -0,0 +1,126 @@
+--------------------------------------------------------------------------------
+-- | DBus module for Intel Backlight control
+
+module XMonad.Internal.DBus.Brightness.IntelBacklight
+  ( callGetBrightnessIB
+  , matchSignalIB
+  , exportIntelBacklight
+  , hasBacklight
+  , blPath
+  ) where
+
+import           Data.Either
+import           Data.Int                               (Int32)
+
+import           DBus
+import           DBus.Client
+
+import           System.FilePath.Posix
+
+import           XMonad.Internal.DBus.Brightness.Common
+import           XMonad.Internal.IO
+
+--------------------------------------------------------------------------------
+-- | Low level sysfs functions
+--
+type Brightness = Float
+
+type RawBrightness = Int32
+
+steps :: Int
+steps = 16
+
+backlightDir :: FilePath
+backlightDir = "/sys/class/backlight/intel_backlight/"
+
+maxFile :: FilePath
+maxFile = backlightDir </> "max_brightness"
+
+curFile :: FilePath
+curFile = backlightDir </> "brightness"
+
+getMaxRawBrightness :: IO RawBrightness
+getMaxRawBrightness = readInt maxFile
+
+getBrightness :: RawBrightness -> IO Brightness
+getBrightness upper = readPercent upper curFile
+
+minBrightness :: RawBrightness -> IO Brightness
+minBrightness upper = writePercentMin upper curFile
+
+maxBrightness :: RawBrightness -> IO Brightness
+maxBrightness upper = writePercentMax upper curFile
+
+incBrightness :: RawBrightness -> IO Brightness
+incBrightness = incPercent steps curFile
+
+decBrightness :: RawBrightness -> IO Brightness
+decBrightness = decPercent steps curFile
+
+--------------------------------------------------------------------------------
+-- | Access checks
+
+-- | determine if backlight is accessible/present
+-- Right True -> backlight accessible and present
+-- Right False -> backlight not present
+-- Left x -> backlight present but could not access (x explaining why)
+hasBacklight' :: IO (Either String Bool)
+hasBacklight' = do
+  mx <- isReadable maxFile
+  cx <- isWritable curFile
+  return $ case (mx, cx) of
+    (NotFoundError, NotFoundError) -> Right False
+    (PermResult True, PermResult True) -> Right True
+    (PermResult _, PermResult _) -> Left "Insufficient permissions for backlight files"
+    _ -> Left "Could not determine permissions for backlight files"
+
+msg :: Either String Bool -> IO ()
+msg (Right True)  = return ()
+msg (Right False) = putStrLn "No backlight detected. Controls disabled"
+msg (Left m)      = putStrLn $ "WARNING: " ++ m
+
+hasBacklightMsg :: IO Bool
+hasBacklightMsg = do
+  b <- hasBacklight'
+  msg b
+  return $ fromRight False b
+
+hasBacklight :: IO Bool
+hasBacklight = fromRight False <$> hasBacklight'
+
+--------------------------------------------------------------------------------
+-- | DBus interface
+
+blPath :: ObjectPath
+blPath = objectPath_ "/intelbacklight"
+
+interface :: InterfaceName
+interface = interfaceName_ "org.xmonad.Brightness"
+
+intelBacklightConfig :: BrightnessConfig RawBrightness Brightness
+intelBacklightConfig = BrightnessConfig
+  { bcMin = minBrightness
+  , bcMax = maxBrightness
+  , bcInc = incBrightness
+  , bcDec = decBrightness
+  , bcGet = getBrightness
+  , bcGetMax = getMaxRawBrightness
+  , bcPath = blPath
+  , bcInterface = interface
+  }
+
+--------------------------------------------------------------------------------
+-- | Exported haskell API
+
+exportIntelBacklight :: Client -> IO (Maybe BrightnessControls)
+exportIntelBacklight client = do
+  b <- hasBacklightMsg
+  if b
+    then Just <$> exportBrightnessControls intelBacklightConfig client
+    else return Nothing
+
+callGetBrightnessIB :: IO (Maybe Brightness)
+callGetBrightnessIB = callGetBrightness intelBacklightConfig
+
+matchSignalIB :: (Maybe Brightness -> IO ()) -> IO SignalHandler
+matchSignalIB = matchSignal intelBacklightConfig

lib/XMonad/Internal/DBus/Control.hs

@@ -9,6 +9,7 @@ module XMonad.Internal.DBus.Control
   , stopXMonadService
   , pathExists
   , xmonadBus
+  , DBusXMonad(..)
   ) where
 
 import           Data.Either
@@ -16,10 +17,11 @@ import           Data.Either
 import           DBus
 import           DBus.Client
 
+import           XMonad.Internal.DBus.Brightness.Common
+import           XMonad.Internal.DBus.Brightness.IntelBacklight
 import           XMonad.Internal.DBus.Common
-import           XMonad.Internal.DBus.IntelBacklight
 import           XMonad.Internal.DBus.Screensaver
-import           XMonad.Internal.Shell
+import           XMonad.Internal.Dependency
 
 introspectInterface :: InterfaceName
 introspectInterface = interfaceName_ "org.freedesktop.DBus.Introspectable"
@@ -27,20 +29,33 @@ introspectInterface = interfaceName_ "org.freedesktop.DBus.Introspectable"
 introspectMethod :: MemberName
 introspectMethod = memberName_ "Introspect"
 
-startXMonadService :: IO (Client, Maybe BacklightControls, MaybeExe SSControls)
+data DBusXMonad = DBusXMonad
+  { dxClient             :: Client
+  , dxIntelBacklightCtrl :: Maybe BrightnessControls
+  , dxClevoBacklightCtrl :: Maybe BrightnessControls
+  , dxScreensaverCtrl    :: MaybeExe SSControls
+  }
+
+startXMonadService :: IO DBusXMonad
 startXMonadService = do
   client <- connectSession
   requestResult <- requestName client xmonadBus []
   -- TODO if the client is not released on shutdown the owner will be
   -- different
-  if requestResult /= NamePrimaryOwner then do
+  (i, c, s) <- if requestResult /= NamePrimaryOwner then do
     putStrLn "Another service owns \"org.xmonad\""
-    return (client, Nothing, Ignore)
+    return (Nothing, Nothing, Ignore)
-  else do
+    else do
     putStrLn "Started xmonad dbus client"
     bc <- exportIntelBacklight client
     sc <- exportScreensaver client
-    return (client, bc, sc)
+    return (bc, Nothing, sc)
+  return $ DBusXMonad
+    { dxClient = client
+    , dxIntelBacklightCtrl = i
+    , dxClevoBacklightCtrl = c
+    , dxScreensaverCtrl = s
+    }
 
 stopXMonadService :: Client -> IO ()
 stopXMonadService client = do

lib/XMonad/Internal/DBus/IntelBacklight.hs

@@ -1,205 +0,0 @@
---------------------------------------------------------------------------------
--- | DBus module for Intel Backlight control
-
-module XMonad.Internal.DBus.IntelBacklight
-  ( callGetBrightness
-  , exportIntelBacklight
-  , matchSignal
-  , hasBacklight
-  , blPath
-  , BacklightControls(..)
-  ) where
-
-import           Control.Monad               (void)
-
-import           Data.Either
-import           Data.Int                    (Int32)
-
-import           DBus
-import           DBus.Client
-
-import           System.FilePath.Posix
-
-import           XMonad.Internal.DBus.Common
-import           XMonad.Internal.IO
-
---------------------------------------------------------------------------------
--- | Low level sysfs functions
---
-type Brightness = Float
-
-type RawBrightness = Int32
-
-steps :: Int
-steps = 16
-
-backlightDir :: FilePath
-backlightDir = "/sys/class/backlight/intel_backlight/"
-
-maxFile :: FilePath
-maxFile = backlightDir </> "max_brightness"
-
-curFile :: FilePath
-curFile = backlightDir </> "brightness"
-
-getMaxRawBrightness :: IO RawBrightness
-getMaxRawBrightness = readInt maxFile
-
-getBrightness :: RawBrightness -> IO Brightness
-getBrightness upper = readPercent upper curFile
-
-minBrightness :: RawBrightness -> IO Brightness
-minBrightness upper = writePercentMin upper curFile
-
-maxBrightness :: RawBrightness -> IO Brightness
-maxBrightness upper = writePercentMax upper curFile
-
-incBrightness :: RawBrightness -> IO Brightness
-incBrightness = incPercent steps curFile
-
-decBrightness :: RawBrightness -> IO Brightness
-decBrightness = decPercent steps curFile
-
---------------------------------------------------------------------------------
--- | Access checks
-
--- | determine if backlight is accessible/present
--- Right True -> backlight accessible and present
--- Right False -> backlight not present
--- Left x -> backlight present but could not access (x explaining why)
-hasBacklight' :: IO (Either String Bool)
-hasBacklight' = do
-  mx <- isReadable maxFile
-  cx <- isWritable curFile
-  return $ case (mx, cx) of
-    (NotFoundError, NotFoundError) -> Right False
-    (PermResult True, PermResult True) -> Right True
-    (PermResult _, PermResult _) -> Left "Insufficient permissions for backlight files"
-    _ -> Left "Could not determine permissions for backlight files"
-
-msg :: Either String Bool -> IO ()
-msg (Right True)  = return ()
-msg (Right False) = putStrLn "No backlight detected. Controls disabled"
-msg (Left m)      = putStrLn $ "WARNING: " ++ m
-
-hasBacklightMsg :: IO Bool
-hasBacklightMsg = do
-  b <- hasBacklight'
-  msg b
-  return $ fromRight False b
-
-hasBacklight :: IO Bool
-hasBacklight = fromRight False <$> hasBacklight'
-
---------------------------------------------------------------------------------
--- | DBus interface
---
--- Define four methods to increase, decrease, maximize, or minimize the
--- brightness. These methods will all return the current brightness as a 32-bit
--- integer and emit a signal with the same brightness value. Additionally, there
--- is one method to get the current brightness.
-
-blPath :: ObjectPath
-blPath = objectPath_ "/intelbacklight"
-
-interface :: InterfaceName
-interface = interfaceName_ "org.xmonad.Brightness"
-
-memCurrentBrightness :: MemberName
-memCurrentBrightness = memberName_ "CurrentBrightness"
-
-memGetBrightness :: MemberName
-memGetBrightness = memberName_ "GetBrightness"
-
-memMaxBrightness :: MemberName
-memMaxBrightness = memberName_ "MaxBrightness"
-
-memMinBrightness :: MemberName
-memMinBrightness = memberName_ "MinBrightness"
-
-memIncBrightness :: MemberName
-memIncBrightness = memberName_ "IncBrightness"
-
-memDecBrightness :: MemberName
-memDecBrightness = memberName_ "DecBrightness"
-
-brSignal :: Signal
-brSignal = signal blPath interface memCurrentBrightness
-  -- { signalDestination = Just "org.xmonad" }
-
-brMatcher :: MatchRule
-brMatcher = matchAny
-  { matchPath = Just blPath
-  , matchInterface = Just interface
-  , matchMember = Just memCurrentBrightness
-  }
-
-callBacklight :: MemberName -> IO ()
-callBacklight method = void $ callMethod $ methodCall blPath interface method
-
-bodyGetBrightness :: [Variant] -> Maybe Brightness
-bodyGetBrightness [b] = fromIntegral <$> (fromVariant b :: Maybe Int32)
-bodyGetBrightness _   = Nothing
-
---------------------------------------------------------------------------------
--- | Exported haskell API
-
-data BacklightControls = BacklightControls
-  { backlightMax  :: IO ()
-  , backlightMin  :: IO ()
-  , backlightUp   :: IO ()
-  , backlightDown :: IO ()
-  }
-
-exportIntelBacklight :: Client -> IO (Maybe BacklightControls)
-exportIntelBacklight client = do
-  b <- hasBacklightMsg
-  if b then exportIntelBacklight' client >> return (Just bc) else return Nothing
-  where
-    bc =  BacklightControls
-      { backlightMax = callMaxBrightness
-      , backlightMin = callMinBrightness
-      , backlightUp = callIncBrightness
-      , backlightDown = callDecBrightness
-      }
-
-exportIntelBacklight' :: Client -> IO ()
-exportIntelBacklight' client = do
-  maxval <- getMaxRawBrightness -- assume the max value will never change
-  let emit' f = emitBrightness client =<< f maxval
-  export client blPath defaultInterface
-    { interfaceName = interface
-    , interfaceMethods =
-      [ autoMethod memMaxBrightness $ emit' maxBrightness
-      , autoMethod memMinBrightness $ emit' minBrightness
-      , autoMethod memIncBrightness $ emit' incBrightness
-      , autoMethod memDecBrightness $ emit' decBrightness
-      , autoMethod memGetBrightness (round <$> getBrightness maxval :: IO Int32)
-      ]
-    }
-
-emitBrightness :: Client -> Brightness -> IO ()
-emitBrightness client cur = emit client
-  $ brSignal { signalBody = [toVariant (round cur :: Int32)] }
-
-callMaxBrightness :: IO ()
-callMaxBrightness = callBacklight memMaxBrightness
-
-callMinBrightness :: IO ()
-callMinBrightness = callBacklight memMinBrightness
-
-callIncBrightness :: IO ()
-callIncBrightness = callBacklight memIncBrightness
-
-callDecBrightness :: IO ()
-callDecBrightness = callBacklight memDecBrightness
-
-callGetBrightness :: IO (Maybe Brightness)
-callGetBrightness = do
-  reply <- callMethod $ methodCall blPath interface memGetBrightness
-  return $ reply >>= bodyGetBrightness
-
-matchSignal :: (Maybe Brightness -> IO ()) -> IO SignalHandler
-matchSignal cb = do
-  client <- connectSession
-  addMatch client brMatcher $ cb . bodyGetBrightness . signalBody

lib/XMonad/Internal/DBus/Screensaver.hs

@@ -19,8 +19,8 @@ import           Graphics.X11.XScreenSaver
 import           Graphics.X11.Xlib.Display
 
 import           XMonad.Internal.DBus.Common
+import           XMonad.Internal.Dependency
 import           XMonad.Internal.Process
-import           XMonad.Internal.Shell
 
 --------------------------------------------------------------------------------
 -- | Low-level functions

lib/XMonad/Internal/Dependency.hs

@@ -0,0 +1,177 @@
+--------------------------------------------------------------------------------
+-- | Functions for handling dependencies
+
+module XMonad.Internal.Dependency
+  ( MaybeExe(..)
+  , UnitType(..)
+  , Dependency(..)
+  , MaybeX
+  , exe
+  , systemUnit
+  , userUnit
+  , runIfInstalled
+  , depInstalled
+  , warnMissing
+  , whenInstalled
+  , ifInstalled
+  , spawnIfInstalled
+  , spawnCmdIfInstalled
+  , noCheck
+  , fmtCmd
+  , spawnCmd
+  , doubleQuote
+  , singleQuote
+  , (#!&&)
+  , (#!||)
+  , (#!|)
+  , (#!>>)
+  , playSound
+  , spawnSound
+  ) where
+
+import           Control.Monad           (filterM)
+import           Control.Monad.IO.Class
+
+import           Data.Maybe              (isJust)
+
+-- import           System.Directory        (findExecutable, readable, writable)
+import           System.Directory        (findExecutable)
+import           System.Exit
+import           System.FilePath
+
+import           XMonad.Core             (X, getXMonadDir)
+-- import           XMonad.Internal.IO
+import           XMonad.Internal.Process
+import           XMonad.Internal.Shell
+
+--------------------------------------------------------------------------------
+-- | Gracefully handling missing binaries
+
+data UnitType = SystemUnit | UserUnit deriving (Eq, Show)
+
+data DependencyType = Executable
+  -- | AccessiblePath FilePath Bool Bool
+  | Systemd UnitType deriving (Eq, Show)
+
+data Dependency = Dependency
+  { depRequired :: Bool
+  , depName     :: String
+  , depType     :: DependencyType
+  }
+  deriving (Eq, Show)
+
+exe :: String -> Dependency
+exe n = Dependency
+  { depRequired = True
+  , depName = n
+  , depType = Executable
+  }
+
+unit :: UnitType -> String -> Dependency
+unit t n = Dependency
+  { depRequired = True
+  , depName = n
+  , depType = Systemd t
+  }
+
+systemUnit :: String -> Dependency
+systemUnit = unit SystemUnit
+
+userUnit :: String -> Dependency
+userUnit = unit UserUnit
+
+data MaybeExe a = Installed a [Dependency] | Missing [Dependency] | Ignore
+
+instance Functor MaybeExe where
+  fmap f (Installed x ds) = Installed (f x) ds
+  fmap _ (Missing x)      = Missing x
+  fmap _ Ignore           = Ignore
+
+type MaybeX = MaybeExe (X ())
+
+warnMissing :: Dependency -> IO ()
+warnMissing Dependency {depRequired = r, depName = n, depType = t } =
+  putStrLn $ "WARNING: " ++ r' ++ " " ++ fmtType t ++ " not found: " ++ n
+  where
+    fmtType Executable           = "executable"
+    -- fmtType (AccessiblePath _ _ _) = undefined
+    fmtType (Systemd UserUnit)   = "systemd user unit"
+    fmtType (Systemd SystemUnit) = "systemd system unit"
+    r' = if r then "required" else "optional"
+
+exeInstalled :: String -> IO Bool
+exeInstalled x = isJust <$> findExecutable x
+
+unitInstalled :: String -> UnitType -> IO Bool
+unitInstalled x u = do
+  (rc, _, _) <- readCreateProcessWithExitCode' (shell cmd) ""
+  return $ case rc of
+    ExitSuccess -> True
+    _           -> False
+  where
+    cmd = fmtCmd "systemctl" $ ["--user" | u == UserUnit] ++ ["status", x]
+
+-- pathAccessible :: FilePath -> Bool -> Bool -> IO (Maybe String)
+-- pathAccessible p testread testwrite = do
+--   res <- getPermissionsSafe p
+--   let msg = permMsg res
+--   return $ fmap (\m -> m ++ ": " ++ p) msg
+--   where
+--     testPerm False _ _ = Nothing
+--     testPerm True f r  = Just $ f r
+--     permMsg NotFoundError            = Just "file not found"
+--     permMsg PermError                = Just "could not get permissions"
+--     permMsg (PermResult r) =
+--       case (testPerm testread readable r, testPerm testwrite writable r) of
+--         (Just False, Just False) -> Just "file not readable or writable"
+--         (Just False, _)          -> Just "file not readable"
+--         (_, Just False)          -> Just "file not writable"
+--         _                        -> Nothing
+
+depInstalled :: Dependency -> IO Bool
+depInstalled Dependency { depName = n, depType = t } =
+  case t of
+    Executable -> exeInstalled n
+    -- (AccessiblePath p r w) -> pathAccessible p r w
+    Systemd u  -> unitInstalled n u
+
+filterMissing :: [Dependency] -> IO [Dependency]
+filterMissing = filterM (fmap not . depInstalled)
+
+runIfInstalled :: MonadIO m => [Dependency] -> m () -> IO (MaybeExe (m ()))
+runIfInstalled ds x = do
+  missing <- filterMissing ds
+  return $ if not $ any depRequired missing
+    then Installed x $ filter (not . depRequired) missing
+    else Missing missing
+
+spawnIfInstalled :: MonadIO m => String -> IO (MaybeExe (m ()))
+spawnIfInstalled n = runIfInstalled [exe n] $ spawn n
+
+spawnCmdIfInstalled :: MonadIO m => String -> [String] -> IO (MaybeExe (m ()))
+spawnCmdIfInstalled n args = runIfInstalled [exe n] $ spawnCmd n args
+
+whenInstalled :: Monad m => MaybeExe (m ()) -> m ()
+whenInstalled = flip ifInstalled skip
+
+ifInstalled ::  MaybeExe a -> a -> a
+ifInstalled (Installed x _) _ = x
+ifInstalled _ alt             = alt
+
+noCheck :: Monad m => a () -> m (MaybeExe (a ()))
+noCheck = return . flip Installed []
+
+-- not sure what to do with these
+
+soundDir :: FilePath
+soundDir = "sound"
+
+spawnSound :: MonadIO m => FilePath -> m () -> m () -> IO (MaybeExe (m ()))
+spawnSound file pre post = runIfInstalled [exe "paplay"]
+  $ pre >> playSound file >> post
+
+playSound :: MonadIO m => FilePath -> m ()
+playSound file = do
+  path <- (</> soundDir </> file) <$> getXMonadDir
+  -- paplay seems to have less latency than aplay
+  spawnCmd "paplay" [path]

lib/XMonad/Internal/Shell.hs

@@ -2,25 +2,8 @@
 -- | Functions for formatting and spawning shell commands
 
 module XMonad.Internal.Shell
-  ( MaybeExe(..)
+  ( fmtCmd
-  , UnitType(..)
-  , Dependency(..)
-  , MaybeX
-  , exe
-  , systemUnit
-  , userUnit
-  , runIfInstalled
-  , depInstalled
-  , warnMissing
-  , whenInstalled
-  , ifInstalled
-  , spawnIfInstalled
-  , spawnCmdIfInstalled
-  , noCheck
-  , fmtCmd
   , spawnCmd
-  , spawnSound
-  , playSound
   , doubleQuote
   , singleQuote
   , skip
@@ -30,137 +13,16 @@ module XMonad.Internal.Shell
   , (#!>>)
   ) where
 
-import           Control.Monad           (filterM)
 import           Control.Monad.IO.Class
 
-import           Data.Maybe              (isJust)
-
-import           System.Directory        (findExecutable)
-import           System.Exit
-import           System.FilePath.Posix
-
-import           XMonad.Core             (X, getXMonadDir)
 import           XMonad.Internal.Process
 
---------------------------------------------------------------------------------
--- | Gracefully handling missing binaries
-
-data UnitType = SystemUnit | UserUnit deriving (Eq, Show)
-
-data DependencyType = Executable | Systemd UnitType deriving (Eq, Show)
-
-data Dependency = Dependency
-  { depRequired :: Bool
-  , depName     :: String
-  , depType     :: DependencyType
-  }
-  deriving (Eq, Show)
-
-exe :: String -> Dependency
-exe n = Dependency
-  { depRequired = True
-  , depName = n
-  , depType = Executable }
-
-unit :: UnitType -> String -> Dependency
-unit t n = Dependency
-  { depRequired = True
-  , depName = n
-  , depType = Systemd t }
-
-systemUnit :: String -> Dependency
-systemUnit = unit SystemUnit
-
-userUnit :: String -> Dependency
-userUnit = unit UserUnit
-
-data MaybeExe a = Installed a [Dependency] | Missing [Dependency] | Ignore
-
-instance Functor MaybeExe where
-  fmap f (Installed x ds) = Installed (f x) ds
-  fmap _ (Missing x)      = Missing x
-  fmap _ Ignore           = Ignore
-
-type MaybeX = MaybeExe (X ())
-
-warnMissing :: Dependency -> IO ()
-warnMissing Dependency {depRequired = r, depName = n, depType = t } =
-  putStrLn $ "WARNING: " ++ r' ++ " " ++ fmtType t ++ " not found: " ++ n
-  where
-    fmtType Executable = "executable"
-    fmtType (Systemd u) =
-      "systemd " ++ (if u == UserUnit then "user" else "system") ++ " unit"
-    r' = if r then "required" else "optional"
-
-exeInstalled :: String -> IO Bool
-exeInstalled x = isJust <$> findExecutable x
-
-unitInstalled :: String -> UnitType -> IO Bool
-unitInstalled x u = do
-  (rc, _, _) <- readCreateProcessWithExitCode' (shell cmd) ""
-  return $ case rc of
-    ExitSuccess -> True
-    _           -> False
-  where
-    cmd = fmtCmd "systemctl" $ ["--user" | u == UserUnit] ++ ["status", x]
-
-depInstalled :: Dependency -> IO Bool
-depInstalled Dependency { depName = n, depType = t } =
-  case t of
-    Executable -> exeInstalled n
-    Systemd u  -> unitInstalled n u
-
-filterMissing :: [Dependency] -> IO [Dependency]
-filterMissing = filterM (fmap not . depInstalled)
-
-runIfInstalled :: MonadIO m => [Dependency] -> m () -> IO (MaybeExe (m ()))
-runIfInstalled ds x = do
-  missing <- filterMissing ds
-  return $ if not $ any depRequired missing
-    then Installed x $ filter (not . depRequired) missing
-    else Missing missing
-
-spawnIfInstalled :: MonadIO m => String -> IO (MaybeExe (m ()))
-spawnIfInstalled n = runIfInstalled [exe n] $ spawn n
-
-spawnCmdIfInstalled :: MonadIO m => String -> [String] -> IO (MaybeExe (m ()))
-spawnCmdIfInstalled n args = runIfInstalled [exe n] $ spawnCmd n args
-
-whenInstalled :: Monad m => MaybeExe (m ()) -> m ()
-whenInstalled = flip ifInstalled skip
-
-ifInstalled ::  MaybeExe a -> a -> a
-ifInstalled (Installed x _) _ = x
-ifInstalled _ alt             = alt
-
-skip :: Monad m => m ()
-skip = return ()
-
-noCheck :: Monad m => a () -> m (MaybeExe (a ()))
-noCheck = return . flip Installed []
-
 --------------------------------------------------------------------------------
 -- | Opening subshell
 
 spawnCmd :: MonadIO m => String -> [String] -> m ()
 spawnCmd cmd args = spawn $ fmtCmd cmd args
 
---------------------------------------------------------------------------------
--- | Playing sound
-
-soundDir :: FilePath
-soundDir = "sound"
-
-spawnSound :: MonadIO m => FilePath -> m () -> m () -> IO (MaybeExe (m ()))
-spawnSound file pre post = runIfInstalled [exe "paplay"]
-  $ pre >> playSound file >> post
-
-playSound :: MonadIO m => FilePath -> m ()
-playSound file = do
-  path <- (</> soundDir </> file) <$> getXMonadDir
-  -- paplay seems to have less latency than aplay
-  spawnCmd "paplay" [path]
-
 --------------------------------------------------------------------------------
 -- | Formatting commands
 
@@ -192,3 +54,6 @@ doubleQuote s = "\"" ++ s ++ "\""
 
 singleQuote :: String -> String
 singleQuote s = "'" ++ s ++ "'"
+
+skip :: Monad m => m ()
+skip = return ()

lib/Xmobar/Plugins/IntelBacklight.hs

@@ -16,7 +16,7 @@ import           Control.Monad
 
 import           Xmobar
 
-import           XMonad.Internal.DBus.IntelBacklight
+import           XMonad.Internal.DBus.Brightness.IntelBacklight
 
 newtype IntelBacklight = IntelBacklight String deriving (Read, Show)
 
@@ -26,8 +26,8 @@ blAlias = "intelbacklight"
 instance Exec IntelBacklight where
   alias (IntelBacklight _) = blAlias
   start (IntelBacklight icon) cb = do
-    _ <- matchSignal $ cb . formatBrightness
+    _ <- matchSignalIB $ cb . formatBrightness
-    cb . formatBrightness =<< callGetBrightness
+    cb . formatBrightness =<< callGetBrightnessIB
     forever (threadDelay 5000000)
     where
       formatBrightness = \case

my-xmonad.cabal

@@ -12,12 +12,14 @@ library
                    , XMonad.Internal.Theme
                    , XMonad.Internal.Notify
                    , XMonad.Internal.Shell
+                   , XMonad.Internal.Dependency
                    , XMonad.Internal.IO
                    , XMonad.Internal.Command.Desktop
                    , XMonad.Internal.Command.DMenu
                    , XMonad.Internal.Command.Power
                    , XMonad.Internal.DBus.Common
-                   , XMonad.Internal.DBus.IntelBacklight
+                   , XMonad.Internal.DBus.Brightness.IntelBacklight
+                   , XMonad.Internal.DBus.Brightness.Common
                    , XMonad.Internal.DBus.Control
                    , XMonad.Internal.DBus.Screensaver
                    , XMonad.Internal.Process