ENH check for intel backlight before adding controls

bin/xmonad.hs

@@ -45,6 +45,7 @@ import           XMonad.Internal.Concurrent.ClientMessage
 import           XMonad.Internal.Concurrent.DynamicWorkspaces
 import           XMonad.Internal.Concurrent.Removable
 import           XMonad.Internal.DBus.Control
+import           XMonad.Internal.DBus.IntelBacklight
 import           XMonad.Internal.Process
 import           XMonad.Internal.Shell
 import qualified XMonad.Internal.Theme                        as T
@@ -64,7 +65,7 @@ import           XMonad.Util.WorkspaceCompare
 
 main :: IO ()
 main = do
-  cl <- startXMonadService
+  (cl, bc) <- startXMonadService
   (h, p) <- spawnPipe "xmobar"
   _ <- forkIO runPowermon
   _ <- forkIO runRemovableMon
@@ -74,13 +75,10 @@ main = do
         , childPIDs = [p]
         , childHandles = [h]
         }
-  (ekbs, missing) <- fmap filterExternal $ evalExternal $ externalBindings ts
+  (ekbs, missing) <- fmap filterExternal $ evalExternal $ externalBindings bc ts
-  -- TODO this seems really dumb but I can't print outside the launch function;
+  mapM_ warnMissing missing
-  -- this seems like a buffering problem since I can print something here and
+  -- IDK why this is necessary; nothing prior to this line will print if missing
-  -- then print from the launch function (eg in the X monad) and both messages
+  hFlush stdout
-  -- will print. However, trying to flush the print output from here makes
-  -- xmonad bootloop
-  let missingErrs = warnMissing <$> missing
   launch
     $ ewmh
     $ addKeymap ekbs
@@ -89,7 +87,7 @@ main = do
           , layoutHook = myLayouts
           , manageHook = myManageHook
           , handleEventHook = myEventHook
-          , startupHook = myStartupHook missingErrs
+          , startupHook = myStartupHook
           , workspaces = myWorkspaces
           , logHook = myLoghook h
           , clickJustFocuses = False
@@ -120,9 +118,8 @@ runCleanup ts = io $ do
 -- problem) outside the 'launch' function so pass them here to be printed.
 
 -- TODO add _NET_DESKTOP_VIEWPORTS to _NET_SUPPORTED?
-myStartupHook :: [String] -> X ()
+myStartupHook :: X ()
-myStartupHook msgs = setDefaultCursor xC_left_ptr
+myStartupHook = setDefaultCursor xC_left_ptr
-  <+> io (mapM_ print msgs)
   <+> docksStartupHook
   <+> startupHook def
 
@@ -485,8 +482,8 @@ filterExternal kgs = let kgs' = fmap go kgs in (fst <$> kgs', concatMap snd kgs'
       Ignore         -> (Nothing, [])
     flagMissing s = "[!!!]" ++ s
 
-externalBindings :: ThreadState -> [KeyGroup (IO MaybeX)]
+externalBindings :: Maybe BacklightControls -> ThreadState -> [KeyGroup (IO MaybeX)]
-externalBindings ts =
+externalBindings bc ts =
   [ KeyGroup "Launchers"
     [ KeyBinding "<XF86Search>" "select/launch app" runAppMenu
     , KeyBinding "M-g" "launch clipboard manager" runClipMenu
@@ -524,10 +521,10 @@ externalBindings ts =
     ]
 
   , KeyGroup "System"
-    [ KeyBinding "M-." "backlight up" $ noCheck runIncBacklight
+    [ KeyBinding "M-." "backlight up" $ runMaybe bc backlightUp
-    , KeyBinding "M-," "backlight down" $ noCheck runDecBacklight
+    , KeyBinding "M-," "backlight down" $ runMaybe bc backlightDown
-    , KeyBinding "M-M1-," "backlight min" $ noCheck runMinBacklight
+    , KeyBinding "M-M1-," "backlight min" $ runMaybe bc backlightMin
-    , KeyBinding "M-M1-." "backlight max" $ noCheck runMaxBacklight
+    , KeyBinding "M-M1-." "backlight max" $ runMaybe bc backlightMax
     , KeyBinding "M-<End>" "power menu" $ noCheck runPowerPrompt
     , KeyBinding "M-<Home>" "quit xmonad" $ noCheck runQuitPrompt
     , KeyBinding "M-<Delete>" "lock screen" runScreenLock
@@ -543,3 +540,8 @@ externalBindings ts =
     , KeyBinding "M-<F12>" "switch gpu" runOptimusPrompt
     ]
   ]
+  where
+    -- TODO this is hacky, I shouldn't really need this data structure for
+    -- something that doesn't depend on executables
+    runMaybe c f = return $ maybe Ignore (\x -> Installed (io $ f x) []) c
+

lib/XMonad/Internal/Command/Desktop.hs

@@ -17,10 +17,6 @@ module XMonad.Internal.Command.Desktop
   , runVolumeUp
   , runVolumeMute
   , runToggleBluetooth
-  , runIncBacklight
-  , runDecBacklight
-  , runMinBacklight
-  , runMaxBacklight
   , runToggleDPMS
   , runToggleEthernet
   , runRestart
@@ -44,7 +40,6 @@ import           System.FilePath
 
 import           XMonad.Actions.Volume
 import           XMonad.Core                      hiding (spawn)
-import           XMonad.Internal.DBus.IntelBacklight
 import           XMonad.Internal.DBus.Screensaver
 import           XMonad.Internal.Notify
 import           XMonad.Internal.Process
@@ -151,18 +146,6 @@ runToggleBluetooth = runIfInstalled [exe myBluetooth] $ spawn
   #!>> fmtCmd myBluetooth ["power", "$a", ">", "/dev/null"]
   #!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "bluetooth powered $a"  }
 
-runIncBacklight :: X ()
-runIncBacklight = io $ void callIncBrightness
-
-runDecBacklight :: X ()
-runDecBacklight = io $ void callDecBrightness
-
-runMinBacklight :: X ()
-runMinBacklight = io $ void callMinBrightness
-
-runMaxBacklight :: X ()
-runMaxBacklight = io $ void callMaxBrightness
-
 runToggleDPMS :: X ()
 runToggleDPMS = io $ void callToggle
 

lib/XMonad/Internal/DBus/Common.hs

@@ -28,4 +28,6 @@ callMethod mc = do
 addMatchCallback :: MatchRule -> ([Variant] -> IO ()) -> IO SignalHandler
 addMatchCallback rule cb = do
   client <- connectSession
-  addMatch client rule $ cb . signalBody
+  s <- addMatch client rule $ cb . signalBody
+  disconnect client
+  return s

lib/XMonad/Internal/DBus/Control.hs

@@ -14,19 +14,20 @@ import           DBus.Client
 import           XMonad.Internal.DBus.IntelBacklight
 import           XMonad.Internal.DBus.Screensaver
 
-startXMonadService :: IO Client
+startXMonadService :: IO (Client, Maybe BacklightControls)
 startXMonadService = do
   client <- connectSession
   requestResult <- requestName client "org.xmonad" []
   -- TODO if the client is not released on shutdown the owner will be
   -- different
-  if requestResult /= NamePrimaryOwner then
+  if requestResult /= NamePrimaryOwner then do
     putStrLn "Another service owns \"org.xmonad\""
+    return (client, Nothing)
   else do
     putStrLn "Started xmonad dbus client"
-    exportIntelBacklight client
+    bc <- exportIntelBacklight client
     exportScreensaver client
-  return client
+    return (client, bc)
 
 stopXMonadService :: Client -> IO ()
 stopXMonadService client = do

lib/XMonad/Internal/DBus/IntelBacklight.hs

@@ -11,11 +11,14 @@ module XMonad.Internal.DBus.IntelBacklight
   , callMinBrightness
   , exportIntelBacklight
   , matchSignal
+  , hasBacklight
+  , BacklightControls(..)
   ) where
 
 import           Control.Monad               (void)
 
 import           Data.Char
+import           Data.Either
 import           Data.Int                    (Int16, Int32)
 import           Data.Text                   (pack, unpack)
 import           Data.Text.IO                as T (readFile, writeFile)
@@ -23,6 +26,10 @@ import           Data.Text.IO                as T (readFile, writeFile)
 import           DBus
 import           DBus.Client
 
+import           System.Directory
+import           System.FilePath.Posix
+import           System.IO.Error
+
 import           XMonad.Internal.DBus.Common
 
 --------------------------------------------------------------------------------
@@ -52,11 +59,11 @@ steps = 16
 backlightDir :: FilePath
 backlightDir = "/sys/class/backlight/intel_backlight/"
 
-maxFile :: String
+maxFile :: FilePath
-maxFile = backlightDir ++ "max_brightness"
+maxFile = backlightDir </> "max_brightness"
 
-curFile :: String
+curFile :: FilePath
-curFile = backlightDir ++ "brightness"
+curFile = backlightDir </> "brightness"
 
 readFileInt :: FilePath -> IO RawBrightness
 readFileInt file = read . takeWhile isDigit . unpack <$> T.readFile file
@@ -91,7 +98,7 @@ getBrightness maxRaw = rawToNorm maxRaw <$> getRawBrightness
 
 changeBrightness :: RawBrightness -> Brightness -> IO Brightness
 changeBrightness maxRaw delta = setBrightness maxRaw
-  =<< (+ delta) <$> getBrightness maxRaw
+  . (+ delta) =<< getBrightness maxRaw
 
 setBrightness :: RawBrightness -> Brightness -> IO Brightness
 setBrightness maxRaw newNorm = do
@@ -99,6 +106,41 @@ setBrightness maxRaw newNorm = do
   setRawBrightness $ normToRaw maxRaw newNorm'
   return newNorm'
 
+--------------------------------------------------------------------------------
+-- | 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 <- doesFileExist maxFile
+  cx <- doesFileExist curFile
+  if not $ mx || cx
+    then return $ Right False
+    else do
+    mp <- tryIOError $ readable <$> getPermissions maxFile
+    cp <- tryIOError $ (\p -> writable p && readable p) <$> getPermissions curFile
+    return $ case (mp, cp) of
+      (Right True, Right True) -> Right True
+      (Right _, Right _) -> Left "Insufficient permissions for backlight files"
+      _                  -> Left "Could not determine backlight file permissions"
+
+msg :: Either String Bool -> IO ()
+msg (Right True)  = return ()
+msg (Right False) = print ("No backlight detected. Controls disabled" :: String)
+msg (Left m)      = print ("WARNING: " ++ m)
+
+hasBacklightMsg :: IO Bool
+hasBacklightMsg = do
+  b <- hasBacklight'
+  msg b
+  return $ fromRight False b
+
+hasBacklight :: IO Bool
+hasBacklight = fromRight False <$> hasBacklight'
+
 --------------------------------------------------------------------------------
 -- | DBus interface
 --
@@ -122,8 +164,8 @@ memGetBrightness = "GetBrightness"
 memMaxBrightness :: MemberName
 memMaxBrightness = "MaxBrightness"
 
-memMinnBrightness :: MemberName
+memMinBrightness :: MemberName
-memMinnBrightness = "MinBrightness"
+memMinBrightness = "MinBrightness"
 
 memIncBrightness :: MemberName
 memIncBrightness = "IncBrightness"
@@ -142,7 +184,6 @@ brMatcher = matchAny
   , matchMember = Just memCurrentBrightness
   }
 
-
 callBacklight :: MemberName -> IO ()
 callBacklight method = void $ callMethod $ methodCall path interface method
 
@@ -153,8 +194,20 @@ bodyGetBrightness _   = Nothing
 --------------------------------------------------------------------------------
 -- | Exported haskell API
 
-exportIntelBacklight :: Client -> IO ()
+data BacklightControls = BacklightControls
+  { backlightMax  :: IO ()
+  , backlightMin  :: IO ()
+  , backlightUp   :: IO ()
+  , backlightDown :: IO ()
+  }
+
+exportIntelBacklight :: Client -> IO (Maybe BacklightControls)
 exportIntelBacklight client = do
+  b <- hasBacklightMsg
+  if b then Just <$> exportIntelBacklight' client else return Nothing
+
+exportIntelBacklight' :: Client -> IO BacklightControls
+exportIntelBacklight' client = do
   maxval <- getMaxRawBrightness -- assume the max value will never change
   let stepsize = maxBrightness `div` steps
   let emit' = emitBrightness client
@@ -162,12 +215,18 @@ exportIntelBacklight client = do
     { interfaceName = interface
     , interfaceMethods =
       [ autoMethod memMaxBrightness $ emit' =<< setBrightness maxval maxBrightness
-      , autoMethod memMinnBrightness $ emit' =<< setBrightness maxval 0
+      , autoMethod memMinBrightness $ emit' =<< setBrightness maxval 0
       , autoMethod memIncBrightness $ emit' =<< changeBrightness maxval stepsize
       , autoMethod memDecBrightness $ emit' =<< changeBrightness maxval (-stepsize)
       , autoMethod memGetBrightness $ getBrightness maxval
       ]
     }
+  return $ BacklightControls
+    { backlightMax = callMaxBrightness
+    , backlightMin = callMinBrightness
+    , backlightUp = callIncBrightness
+    , backlightDown = callDecBrightness
+    }
 
 emitBrightness :: Client -> Brightness -> IO ()
 emitBrightness client cur = emit client $ brSignal { signalBody = [toVariant cur] }
@@ -176,7 +235,7 @@ callMaxBrightness :: IO ()
 callMaxBrightness = callBacklight memMaxBrightness
 
 callMinBrightness :: IO ()
-callMinBrightness = callBacklight memMinnBrightness
+callMinBrightness = callBacklight memMinBrightness
 
 callIncBrightness :: IO ()
 callIncBrightness = callBacklight memIncBrightness

lib/XMonad/Internal/Shell.hs

@@ -80,9 +80,9 @@ type MaybeX = MaybeExe X
 
 type IOMaybeX = IO MaybeX
 
-warnMissing :: Dependency -> String
+warnMissing :: Dependency -> IO ()
 warnMissing Dependency {depRequired = r, depName = n, depType = t } =
-  "WARNING: " ++ r' ++ " " ++ fmtType t ++ " not found: " ++ n
+  putStrLn $ "WARNING: " ++ r' ++ " " ++ fmtType t ++ " not found: " ++ n
   where
     fmtType Executable = "executable"
     fmtType (Systemd u) =