ENH distinguish between required and optional deps
This commit is contained in:
parent
7f62b27a5a
commit
461fc783c7
|
@ -468,8 +468,8 @@ filterExternal = fmap go
|
||||||
where
|
where
|
||||||
go k@KeyGroup { kgBindings = bs } =
|
go k@KeyGroup { kgBindings = bs } =
|
||||||
k { kgBindings = mapMaybe go' bs }
|
k { kgBindings = mapMaybe go' bs }
|
||||||
go' k@KeyBinding { kbAction = Installed x } = Just $ k { kbAction = x }
|
go' k@KeyBinding { kbAction = Installed x _ } = Just $ k { kbAction = x }
|
||||||
go' _ = Nothing
|
go' _ = Nothing
|
||||||
|
|
||||||
externalBindings :: ThreadState -> [KeyGroup (IO MaybeX)]
|
externalBindings :: ThreadState -> [KeyGroup (IO MaybeX)]
|
||||||
externalBindings ts =
|
externalBindings ts =
|
||||||
|
|
|
@ -62,7 +62,7 @@ myDmenuMatchingArgs = ["-i"] -- case insensitivity
|
||||||
-- | Exported Commands
|
-- | Exported Commands
|
||||||
|
|
||||||
runDevMenu :: IO MaybeX
|
runDevMenu :: IO MaybeX
|
||||||
runDevMenu = runIfInstalled [myDmenuDevices] $ do
|
runDevMenu = runIfInstalled [Required myDmenuDevices] $ do
|
||||||
c <- io $ getXdgDirectory XdgConfig "rofi/devices.yml"
|
c <- io $ getXdgDirectory XdgConfig "rofi/devices.yml"
|
||||||
spawnCmd myDmenuDevices
|
spawnCmd myDmenuDevices
|
||||||
$ ["-c", c]
|
$ ["-c", c]
|
||||||
|
@ -70,7 +70,7 @@ runDevMenu = runIfInstalled [myDmenuDevices] $ do
|
||||||
++ myDmenuMatchingArgs
|
++ myDmenuMatchingArgs
|
||||||
|
|
||||||
runBwMenu :: IO MaybeX
|
runBwMenu :: IO MaybeX
|
||||||
runBwMenu = runIfInstalled [myDmenuPasswords] $
|
runBwMenu = runIfInstalled [Required myDmenuPasswords] $
|
||||||
spawnCmd myDmenuPasswords $ ["-c", "--"] ++ themeArgs "#bb6600" ++ myDmenuMatchingArgs
|
spawnCmd myDmenuPasswords $ ["-c", "--"] ++ themeArgs "#bb6600" ++ myDmenuMatchingArgs
|
||||||
|
|
||||||
-- TODO what to do with this if rofi doesn't exist?
|
-- TODO what to do with this if rofi doesn't exist?
|
||||||
|
|
|
@ -91,7 +91,7 @@ runTerm :: IO MaybeX
|
||||||
runTerm = spawnIfInstalled myTerm
|
runTerm = spawnIfInstalled myTerm
|
||||||
|
|
||||||
runTMux :: IO MaybeX
|
runTMux :: IO MaybeX
|
||||||
runTMux = runIfInstalled [myTerm, "tmux", "bash"] cmd
|
runTMux = runIfInstalled [Required myTerm, Required "tmux", Required "bash"] cmd
|
||||||
where
|
where
|
||||||
cmd = spawn
|
cmd = spawn
|
||||||
$ "tmux has-session"
|
$ "tmux has-session"
|
||||||
|
@ -101,7 +101,7 @@ runTMux = runIfInstalled [myTerm, "tmux", "bash"] cmd
|
||||||
msg = "could not connect to tmux session"
|
msg = "could not connect to tmux session"
|
||||||
|
|
||||||
runCalc :: IO MaybeX
|
runCalc :: IO MaybeX
|
||||||
runCalc = runIfInstalled [myTerm, "R"] $ spawnCmd myTerm ["-e", "R"]
|
runCalc = runIfInstalled [Required myTerm, Required "R"] $ spawnCmd myTerm ["-e", "R"]
|
||||||
|
|
||||||
runBrowser :: IO MaybeX
|
runBrowser :: IO MaybeX
|
||||||
runBrowser = spawnIfInstalled myBrowser
|
runBrowser = spawnIfInstalled myBrowser
|
||||||
|
@ -144,7 +144,7 @@ runVolumeMute = spawnSound volumeChangeSound (void toggleMute) $ return ()
|
||||||
-- | System commands
|
-- | System commands
|
||||||
|
|
||||||
runToggleBluetooth :: IO MaybeX
|
runToggleBluetooth :: IO MaybeX
|
||||||
runToggleBluetooth = runIfInstalled [myBluetooth] $ spawn
|
runToggleBluetooth = runIfInstalled [Required myBluetooth] $ spawn
|
||||||
$ myBluetooth ++ " show | grep -q \"Powered: no\""
|
$ myBluetooth ++ " show | grep -q \"Powered: no\""
|
||||||
#!&& "a=on"
|
#!&& "a=on"
|
||||||
#!|| "a=off"
|
#!|| "a=off"
|
||||||
|
@ -167,7 +167,7 @@ runToggleDPMS :: X ()
|
||||||
runToggleDPMS = io $ void callToggle
|
runToggleDPMS = io $ void callToggle
|
||||||
|
|
||||||
runToggleEthernet :: IO MaybeX
|
runToggleEthernet :: IO MaybeX
|
||||||
runToggleEthernet = runIfInstalled ["nmcli"] $ spawn
|
runToggleEthernet = runIfInstalled [Required "nmcli"] $ spawn
|
||||||
$ "nmcli -g GENERAL.STATE device show " ++ ethernetIface ++ " | grep -q disconnected"
|
$ "nmcli -g GENERAL.STATE device show " ++ ethernetIface ++ " | grep -q disconnected"
|
||||||
#!&& "a=connect"
|
#!&& "a=connect"
|
||||||
#!|| "a=disconnect"
|
#!|| "a=disconnect"
|
||||||
|
@ -225,7 +225,7 @@ getCaptureDir = do
|
||||||
fallback = (</> ".local/share") <$> getHomeDirectory
|
fallback = (</> ".local/share") <$> getHomeDirectory
|
||||||
|
|
||||||
runFlameshot :: String -> IO MaybeX
|
runFlameshot :: String -> IO MaybeX
|
||||||
runFlameshot mode = runIfInstalled [myCapture] $ do
|
runFlameshot mode = runIfInstalled [Required myCapture] $ do
|
||||||
ssDir <- io getCaptureDir
|
ssDir <- io getCaptureDir
|
||||||
spawnCmd myCapture $ mode : ["-p", ssDir]
|
spawnCmd myCapture $ mode : ["-p", ssDir]
|
||||||
|
|
||||||
|
@ -243,6 +243,6 @@ runScreenCapture :: IO MaybeX
|
||||||
runScreenCapture = runFlameshot "screen"
|
runScreenCapture = runFlameshot "screen"
|
||||||
|
|
||||||
runCaptureBrowser :: IO MaybeX
|
runCaptureBrowser :: IO MaybeX
|
||||||
runCaptureBrowser = runIfInstalled [myImageBrowser] $ do
|
runCaptureBrowser = runIfInstalled [Required myImageBrowser] $ do
|
||||||
dir <- io getCaptureDir
|
dir <- io getCaptureDir
|
||||||
spawnCmd myImageBrowser [dir]
|
spawnCmd myImageBrowser [dir]
|
||||||
|
|
|
@ -3,6 +3,7 @@
|
||||||
|
|
||||||
module XMonad.Internal.Shell
|
module XMonad.Internal.Shell
|
||||||
( MaybeExe(..)
|
( MaybeExe(..)
|
||||||
|
, Dependency(..)
|
||||||
, MaybeX
|
, MaybeX
|
||||||
, IOMaybeX
|
, IOMaybeX
|
||||||
, runIfInstalled
|
, runIfInstalled
|
||||||
|
@ -25,45 +26,57 @@ module XMonad.Internal.Shell
|
||||||
import Control.Monad (filterM)
|
import Control.Monad (filterM)
|
||||||
import Control.Monad.IO.Class
|
import Control.Monad.IO.Class
|
||||||
|
|
||||||
import Data.Maybe (isNothing)
|
import Data.Maybe (isJust)
|
||||||
|
|
||||||
import System.FilePath.Posix
|
|
||||||
import System.Directory (findExecutable)
|
import System.Directory (findExecutable)
|
||||||
|
import System.FilePath.Posix
|
||||||
|
|
||||||
import XMonad.Core (getXMonadDir, X)
|
import XMonad.Core (X, getXMonadDir)
|
||||||
import XMonad.Internal.Process
|
import XMonad.Internal.Process
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Gracefully handling missing binaries
|
-- | Gracefully handling missing binaries
|
||||||
|
|
||||||
data MaybeExe m = Installed (m ()) | Missing [String] | Noop
|
data Dependency = Required String | Optional String deriving (Eq, Show)
|
||||||
|
|
||||||
|
data MaybeExe m = Installed (m ()) [String] | Missing [Dependency] | Ignore
|
||||||
|
|
||||||
type MaybeX = MaybeExe X
|
type MaybeX = MaybeExe X
|
||||||
|
|
||||||
type IOMaybeX = IO MaybeX
|
type IOMaybeX = IO MaybeX
|
||||||
|
|
||||||
runIfInstalled :: MonadIO m => [String] -> m () -> IO (MaybeExe m)
|
exeInstalled :: String -> IO Bool
|
||||||
runIfInstalled exes x = do
|
exeInstalled x = isJust <$> findExecutable x
|
||||||
missing <- filterM (fmap isNothing . findExecutable) exes
|
|
||||||
return $ case missing of
|
depInstalled :: Dependency -> IO Bool
|
||||||
[] -> Installed x
|
depInstalled (Required d) = exeInstalled d
|
||||||
ms -> Missing ms
|
depInstalled (Optional d) = exeInstalled d
|
||||||
|
|
||||||
|
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 null [m | Required m <- missing]
|
||||||
|
then Installed x [m | Optional m <- missing]
|
||||||
|
else Missing missing
|
||||||
|
|
||||||
spawnIfInstalled :: MonadIO m => String -> IO (MaybeExe m)
|
spawnIfInstalled :: MonadIO m => String -> IO (MaybeExe m)
|
||||||
spawnIfInstalled exe = runIfInstalled [exe] $ spawn exe
|
spawnIfInstalled exe = runIfInstalled [Required exe] $ spawn exe
|
||||||
|
|
||||||
spawnCmdIfInstalled :: MonadIO m => String -> [String] -> IO (MaybeExe m)
|
spawnCmdIfInstalled :: MonadIO m => String -> [String] -> IO (MaybeExe m)
|
||||||
spawnCmdIfInstalled exe args = runIfInstalled [exe] $ spawnCmd exe args
|
spawnCmdIfInstalled exe args = runIfInstalled [Required exe] $ spawnCmd exe args
|
||||||
|
|
||||||
whenInstalled :: Monad m => MaybeExe m -> m ()
|
whenInstalled :: Monad m => MaybeExe m -> m ()
|
||||||
whenInstalled (Installed x) = x
|
whenInstalled (Installed x _) = x
|
||||||
whenInstalled _ = return ()
|
whenInstalled _ = return ()
|
||||||
|
|
||||||
skip :: Monad m => m ()
|
skip :: Monad m => m ()
|
||||||
skip = return ()
|
skip = return ()
|
||||||
|
|
||||||
noCheck :: Monad m => a () -> m (MaybeExe a)
|
noCheck :: Monad m => a () -> m (MaybeExe a)
|
||||||
noCheck = return . Installed
|
noCheck = return . flip Installed []
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Opening subshell
|
-- | Opening subshell
|
||||||
|
@ -78,7 +91,7 @@ soundDir :: FilePath
|
||||||
soundDir = "sound"
|
soundDir = "sound"
|
||||||
|
|
||||||
spawnSound :: MonadIO m => FilePath -> m () -> m () -> IO (MaybeExe m)
|
spawnSound :: MonadIO m => FilePath -> m () -> m () -> IO (MaybeExe m)
|
||||||
spawnSound file pre post = runIfInstalled ["paplay"]
|
spawnSound file pre post = runIfInstalled [Required "paplay"]
|
||||||
$ pre >> playSound file >> post
|
$ pre >> playSound file >> post
|
||||||
|
|
||||||
playSound :: MonadIO m => FilePath -> m ()
|
playSound :: MonadIO m => FilePath -> m ()
|
||||||
|
|
Loading…
Reference in New Issue