xmonad-config/lib/XMonad/Internal/Shell.hs

195 lines
5.1 KiB
Haskell
Raw Normal View History

2020-04-01 22:06:00 -04:00
--------------------------------------------------------------------------------
-- | Functions for formatting and spawning shell commands
2020-04-01 20:17:47 -04:00
module XMonad.Internal.Shell
2021-06-19 00:17:47 -04:00
( MaybeExe(..)
, UnitType(..)
, Dependency(..)
2021-06-19 00:17:47 -04:00
, MaybeX
, exe
, systemUnit
, userUnit
2021-06-19 00:17:47 -04:00
, runIfInstalled
, depInstalled
2021-06-19 15:32:43 -04:00
, warnMissing
2021-06-19 00:17:47 -04:00
, whenInstalled
, ifInstalled
2021-06-19 00:17:47 -04:00
, spawnIfInstalled
, spawnCmdIfInstalled
, noCheck
, fmtCmd
2020-04-01 20:17:47 -04:00
, spawnCmd
2020-05-31 20:56:57 -04:00
, spawnSound
2021-06-19 00:17:47 -04:00
, playSound
2021-06-17 01:17:59 -04:00
, doubleQuote
, singleQuote
2021-06-19 00:17:47 -04:00
, skip
2020-04-01 20:17:47 -04:00
, (#!&&)
, (#!||)
, (#!|)
2020-04-01 20:17:47 -04:00
, (#!>>)
) where
2020-03-18 12:17:39 -04:00
2021-06-19 00:17:47 -04:00
import Control.Monad (filterM)
import Control.Monad.IO.Class
import Data.Maybe (isJust)
2021-06-19 00:17:47 -04:00
import System.Directory (findExecutable)
import System.Exit
import System.FilePath.Posix
2020-05-31 20:56:57 -04:00
import XMonad.Core (X, getXMonadDir)
import XMonad.Internal.Process
2020-03-28 18:38:38 -04:00
2021-06-19 00:17:47 -04:00
--------------------------------------------------------------------------------
-- | 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
2021-06-19 00:17:47 -04:00
instance Functor MaybeExe where
fmap f (Installed x ds) = Installed (f x) ds
fmap _ (Missing x) = Missing x
fmap _ Ignore = Ignore
2021-06-19 00:17:47 -04:00
type MaybeX = MaybeExe (X ())
2021-06-19 00:17:47 -04:00
warnMissing :: Dependency -> IO ()
warnMissing Dependency {depRequired = r, depName = n, depType = t } =
putStrLn $ "WARNING: " ++ r' ++ " " ++ fmtType t ++ " not found: " ++ n
2021-06-19 15:32:43 -04:00
where
fmtType Executable = "executable"
fmtType (Systemd u) =
"systemd " ++ (if u == UserUnit then "user" else "system") ++ " unit"
r' = if r then "required" else "optional"
2021-06-19 15:32:43 -04:00
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
2021-06-19 00:17:47 -04:00
spawnIfInstalled :: MonadIO m => String -> IO (MaybeExe (m ()))
spawnIfInstalled n = runIfInstalled [exe n] $ spawn n
2021-06-19 00:17:47 -04:00
spawnCmdIfInstalled :: MonadIO m => String -> [String] -> IO (MaybeExe (m ()))
spawnCmdIfInstalled n args = runIfInstalled [exe n] $ spawnCmd n args
2021-06-19 00:17:47 -04:00
whenInstalled :: Monad m => MaybeExe (m ()) -> m ()
whenInstalled = flip ifInstalled skip
ifInstalled :: MaybeExe a -> a -> a
ifInstalled (Installed x _) _ = x
ifInstalled _ alt = alt
2021-06-19 00:17:47 -04:00
skip :: Monad m => m ()
skip = return ()
noCheck :: Monad m => a () -> m (MaybeExe (a ()))
noCheck = return . flip Installed []
2021-06-19 00:17:47 -04:00
2020-04-01 22:06:00 -04:00
--------------------------------------------------------------------------------
-- | Opening subshell
2020-03-18 12:17:39 -04:00
spawnCmd :: MonadIO m => String -> [String] -> m ()
2020-03-18 12:17:39 -04:00
spawnCmd cmd args = spawn $ fmtCmd cmd args
2020-05-31 20:56:57 -04:00
--------------------------------------------------------------------------------
-- | Playing sound
soundDir :: FilePath
soundDir = "sound"
spawnSound :: MonadIO m => FilePath -> m () -> m () -> IO (MaybeExe (m ()))
spawnSound file pre post = runIfInstalled [exe "paplay"]
2021-06-19 00:17:47 -04:00
$ pre >> playSound file >> post
playSound :: MonadIO m => FilePath -> m ()
playSound file = do
2020-05-31 20:56:57 -04:00
path <- (</> soundDir </> file) <$> getXMonadDir
2020-05-31 23:58:30 -04:00
-- paplay seems to have less latency than aplay
spawnCmd "paplay" [path]
2020-05-31 20:56:57 -04:00
2020-04-01 22:06:00 -04:00
--------------------------------------------------------------------------------
-- | Formatting commands
fmtCmd :: String -> [String] -> String
fmtCmd cmd args = unwords $ cmd : args
2020-03-18 12:17:39 -04:00
(#!&&) :: String -> String -> String
cmdA #!&& cmdB = cmdA ++ " && " ++ cmdB
infixr 0 #!&&
(#!|) :: String -> String -> String
cmdA #!| cmdB = cmdA ++ " | " ++ cmdB
infixr 0 #!|
2020-03-18 12:17:39 -04:00
(#!||) :: String -> String -> String
cmdA #!|| cmdB = cmdA ++ " || " ++ cmdB
infixr 0 #!||
(#!>>) :: String -> String -> String
cmdA #!>> cmdB = cmdA ++ "; " ++ cmdB
infixr 0 #!>>
2021-06-17 01:17:59 -04:00
doubleQuote :: String -> String
doubleQuote s = "\"" ++ s ++ "\""
singleQuote :: String -> String
singleQuote s = "'" ++ s ++ "'"