ENH make optimus manager check for deps and gpu card

bin/xmonad.hs

@@ -540,6 +540,6 @@ externalBindings ts =
     , KeyBinding "M-<F9>" "toggle ethernet" runToggleEthernet
     , KeyBinding "M-<F10>" "toggle bluetooth" runToggleBluetooth
     , KeyBinding "M-<F11>" "toggle screensaver" $ noCheck runToggleDPMS
-    , KeyBinding "M-<F12>" "switch gpu" $ noCheck runOptimusPrompt
+    , KeyBinding "M-<F12>" "switch gpu" runOptimusPrompt
     ]
   ]

lib/XMonad/Internal/Command/Power.hs

@@ -21,18 +21,29 @@ import           Graphics.X11.Types
 
 import           System.Directory
 import           System.Exit
+import           System.Process
 
 import           XMonad.Core
+import           XMonad.Internal.Process     (readCreateProcessWithExitCode')
 import           XMonad.Internal.Shell
 import qualified XMonad.Internal.Theme       as T
 import           XMonad.Prompt
 import           XMonad.Prompt.ConfirmPrompt
 
+--------------------------------------------------------------------------------
+-- | Executables
+
+myScreenlock :: String
+myScreenlock = "screenlock"
+
+myOptimusManager :: String
+myOptimusManager = "optimus-manager"
+
 --------------------------------------------------------------------------------
 -- | Core commands
 
 runScreenLock :: IOMaybeX
-runScreenLock = spawnIfInstalled "screenlock"
+runScreenLock = spawnIfInstalled myScreenlock
 
 runPowerOff :: X ()
 runPowerOff = spawn "systemctl poweroff"
@@ -64,17 +75,63 @@ runQuitPrompt = confirmPrompt T.promptTheme "quit?" $ io exitSuccess
 isUsingNvidia :: IO Bool
 isUsingNvidia = doesDirectoryExist "/sys/module/nvidia"
 
-runOptimusPrompt :: X ()
+withShellOutput :: Show a => String -> (String -> a) -> IO (Maybe a)
-runOptimusPrompt = do
+withShellOutput cmd f = do
+  (rc, out, _) <- readCreateProcessWithExitCode' (shell cmd) ""
+  return $ case rc of
+    ExitSuccess -> Just $ f out
+    _           -> Nothing
+
+-- TODO this will work for most of my use cases but won't work in general
+-- because it assumes "Intel" means "integrated graphics" ...sorry AMD
+-- TODO this is hacky AF, I really only need the lspci command and the rest
+-- can be parsed with some simple string matching if I use the -vmm option
+hasSwitchableGPU :: IO (Maybe Bool)
+hasSwitchableGPU = withShellOutput cmd hasIntelAndOther
+  where
+    cmd = fmtCmd "lspci" ["-mm"]
+        #!| fmtCmd "grep" ["VGA"]
+        #!| fmtCmd "sed" ["'s/ \"\\([^\"]*\\)\"*/|\\1/g'"]
+        #!| fmtCmd "cut" ["-f3", "-d'|'"]
+    hasIntelAndOther out =
+      let vendors = lines out
+          ivendors = filter (== "Intel Corporation") vendors in
+      length vendors > length ivendors && not (null ivendors)
+
+-- this is hacky but so much easier than the "pure haskell" solution
+hasBattery :: IO (Maybe Bool)
+hasBattery = withShellOutput (fmtCmd "cat" ["/sys/class/power_supply/*/type"])
+  $ elem "Battery" . lines
+
+requireOptimus :: IO Bool
+requireOptimus = do
+  s <- hasSwitchableGPU
+  b <- hasBattery
+  case (s, b) of
+    (Just True, Just True) -> return True
+    _                      -> warn >> return False
+  where
+    warn = putStrLn
+      "WARNING: could not determine if switchable GPU present. Assuming not"
+
+runOptimusPrompt' :: X ()
+runOptimusPrompt' = do
   nvidiaOn <- io isUsingNvidia
-  switch $ if nvidiaOn then "intel" else "nvidia"
+  switch $ if nvidiaOn then "integrated" else "nvidia"
   where
     switch mode = confirmPrompt T.promptTheme (prompt mode) (cmd mode)
     prompt mode = "gpu switch to " ++ mode ++ "?"
     cmd mode = spawn $
-      unwords ["optimus-manager", "--switch", mode, "--no-confirm"]
+      "prime-offload"
+      #!&& unwords [myOptimusManager, "--switch", mode, "--no-confirm"]
       #!&& "killall xmonad"
 
+runOptimusPrompt :: IO MaybeX
+runOptimusPrompt = do
+  g <- requireOptimus
+  if g then runIfInstalled [Required myOptimusManager] runOptimusPrompt'
+    else return Ignore
+
 --------------------------------------------------------------------------------
 -- | Universal power prompt
 

lib/XMonad/Internal/Process.hs

@@ -6,6 +6,7 @@ module XMonad.Internal.Process
   , killHandle
   , spawnPipe
   , createProcess'
+  , readCreateProcessWithExitCode'
   , proc'
   , shell'
   , spawn
@@ -59,6 +60,10 @@ addGroupSession cp = cp { create_group = True, new_session = True }
 createProcess' :: CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
 createProcess' = withDefaultSignalHandlers . createProcess
 
+readCreateProcessWithExitCode' :: CreateProcess -> String -> IO (ExitCode, String, String)
+readCreateProcessWithExitCode' c i = withDefaultSignalHandlers
+  $ readCreateProcessWithExitCode c i
+
 shell' :: String -> CreateProcess
 shell' = addGroupSession . shell
 

lib/XMonad/Internal/Shell.hs

@@ -21,6 +21,7 @@ module XMonad.Internal.Shell
   , skip
   , (#!&&)
   , (#!||)
+  , (#!|)
   , (#!>>)
   ) where
 
@@ -119,6 +120,11 @@ cmdA #!&& cmdB = cmdA ++ " && " ++ cmdB
 
 infixr 0 #!&&
 
+(#!|) :: String -> String -> String
+cmdA #!| cmdB = cmdA ++ " | " ++ cmdB
+
+infixr 0 #!|
+
 (#!||) :: String -> String -> String
 cmdA #!|| cmdB = cmdA ++ " || " ++ cmdB