ENH make a few more desktop dep trees more specific
This commit is contained in:
parent
3f4de9cf88
commit
8d495123dc
|
@ -11,13 +11,11 @@ module Main (main) where
|
|||
-- * Theme integration with xmonad (shared module imported below)
|
||||
-- * A custom Locks plugin from my own forked repo
|
||||
|
||||
import Data.Either
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
|
||||
import DBus.Client
|
||||
|
||||
import System.Directory
|
||||
import System.Exit
|
||||
import System.IO
|
||||
import System.IO.Error
|
||||
|
@ -181,15 +179,13 @@ type BarFeature = Sometimes CmdSpec
|
|||
-- TODO what if I don't have a wireless card?
|
||||
getWireless :: BarFeature
|
||||
getWireless = sometimes1 "wireless status indicator" "sysfs path"
|
||||
$ IORoot wirelessCmd
|
||||
$ Only $ readInterface "get wifi interface" isWireless
|
||||
$ IORoot wirelessCmd $ Only readWireless
|
||||
|
||||
getEthernet :: Maybe Client -> BarFeature
|
||||
getEthernet cl = iconDBus "ethernet status indicator" root tree
|
||||
where
|
||||
root useIcon tree' = DBusRoot (const . ethernetCmd useIcon) tree' cl
|
||||
tree = And1 (Only readEth) (Only_ devDep)
|
||||
readEth = readInterface "read ethernet interface" isEthernet
|
||||
tree = And1 (Only readEthernet) (Only_ devDep)
|
||||
|
||||
getBattery :: BarFeature
|
||||
getBattery = iconIO_ "battery level indicator" root tree
|
||||
|
@ -389,35 +385,6 @@ dateCmd = CmdSpec
|
|||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | low-level testing functions
|
||||
--
|
||||
-- in the case of network interfaces, assume that the system uses systemd in
|
||||
-- which case ethernet interfaces always start with "en" and wireless
|
||||
-- interfaces always start with "wl"
|
||||
|
||||
isWireless :: String -> Bool
|
||||
isWireless ('w':'l':_) = True
|
||||
isWireless _ = False
|
||||
|
||||
isEthernet :: String -> Bool
|
||||
isEthernet ('e':'n':_) = True
|
||||
isEthernet _ = False
|
||||
|
||||
listInterfaces :: IO [String]
|
||||
listInterfaces = fromRight [] <$> tryIOError (listDirectory sysfsNet)
|
||||
|
||||
sysfsNet :: FilePath
|
||||
sysfsNet = "/sys/class/net"
|
||||
|
||||
readInterface :: String -> (String -> Bool) -> IODependency String
|
||||
readInterface n f = IORead n go
|
||||
where
|
||||
go = io $ do
|
||||
ns <- filter f <$> listInterfaces
|
||||
case ns of
|
||||
[] -> return $ Left [Msg Error "no interfaces found"]
|
||||
(x:xs) -> do
|
||||
return $ Right $ PostPass x
|
||||
$ fmap (Msg Warn . ("ignoring extra interface: " ++)) xs
|
||||
|
||||
vpnPresent :: IO (Maybe Msg)
|
||||
vpnPresent =
|
||||
|
|
|
@ -678,14 +678,15 @@ externalBindings ts db =
|
|||
, KeyBinding "M-C-<F7>" "start Isync Timer" $ Left runStartISyncTimer
|
||||
, KeyBinding "M-<F8>" "select autorandr profile" $ Left runAutorandrMenu
|
||||
, KeyBinding "M-<F9>" "toggle ethernet" $ Left runToggleEthernet
|
||||
, KeyBinding "M-<F10>" "toggle bluetooth" $ Left runToggleBluetooth
|
||||
, KeyBinding "M-<F11>" "toggle screensaver" $ Left $ ioSometimes $ callToggle cl
|
||||
, KeyBinding "M-<F10>" "toggle bluetooth" $ Left $ runToggleBluetooth sys
|
||||
, KeyBinding "M-<F11>" "toggle screensaver" $ Left $ ioSometimes $ callToggle ses
|
||||
, KeyBinding "M-<F12>" "switch gpu" $ Left runOptimusPrompt
|
||||
]
|
||||
]
|
||||
where
|
||||
cl = dbSesClient db
|
||||
brightessControls ctl getter = (ioSometimes . getter . ctl) cl
|
||||
ses = dbSesClient db
|
||||
sys = dbSysClient db
|
||||
brightessControls ctl getter = (ioSometimes . getter . ctl) ses
|
||||
ib = Left . brightessControls intelBacklightControls
|
||||
ck = Left . brightessControls clevoKeyboardControls
|
||||
ftrAlways n = Right . Always n . Always_ . FallbackAlone
|
||||
|
|
|
@ -38,9 +38,11 @@ module XMonad.Internal.Command.Desktop
|
|||
, runNetAppDaemon
|
||||
) where
|
||||
|
||||
import Control.Monad (void)
|
||||
import Control.Monad (void)
|
||||
import Control.Monad.IO.Class
|
||||
|
||||
import DBus.Client
|
||||
|
||||
import System.Directory
|
||||
( createDirectoryIfMissing
|
||||
, getHomeDirectory
|
||||
|
@ -48,9 +50,10 @@ import System.Directory
|
|||
import System.Environment
|
||||
import System.FilePath
|
||||
|
||||
import XMonad (asks)
|
||||
import XMonad (asks)
|
||||
import XMonad.Actions.Volume
|
||||
import XMonad.Core hiding (spawn)
|
||||
import XMonad.Core hiding (spawn)
|
||||
import XMonad.Internal.DBus.Common
|
||||
import XMonad.Internal.Dependency
|
||||
import XMonad.Internal.Notify
|
||||
import XMonad.Internal.Process
|
||||
|
@ -90,10 +93,6 @@ myNotificationCtrl = "dunstctl"
|
|||
volumeChangeSound :: FilePath
|
||||
volumeChangeSound = "smb_fireball.wav"
|
||||
|
||||
-- TODO make this dynamic (like in xmobar)
|
||||
ethernetIface :: String
|
||||
ethernetIface = "enp7s0f1"
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Some nice apps
|
||||
|
||||
|
@ -211,25 +210,29 @@ runNetAppDaemon = sometimesIO_ "network applet" "NM-applet" tree cmd
|
|||
tree = Only_ $ localExe "nm-applet"
|
||||
cmd = snd <$> spawnPipe "nm-applet"
|
||||
|
||||
-- TODO test that bluetooth dbus interface is up
|
||||
runToggleBluetooth :: SometimesX
|
||||
runToggleBluetooth =
|
||||
sometimesIO_ "bluetooth toggle" "bluetoothctl" (Only_ $ sysExe myBluetooth)
|
||||
$ spawn
|
||||
$ myBluetooth ++ " show | grep -q \"Powered: no\""
|
||||
#!&& "a=on"
|
||||
#!|| "a=off"
|
||||
#!>> fmtCmd myBluetooth ["power", "$a", ">", "/dev/null"]
|
||||
#!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "bluetooth powered $a" }
|
||||
runToggleBluetooth :: Maybe Client -> SometimesX
|
||||
runToggleBluetooth cl =
|
||||
sometimesDBus cl "bluetooth toggle" "bluetoothctl" tree cmd
|
||||
where
|
||||
tree = And_ (Only_ $ DBusIO $ sysExe myBluetooth) (Only_ $ Bus btBus)
|
||||
cmd _ = spawn
|
||||
$ myBluetooth ++ " show | grep -q \"Powered: no\""
|
||||
#!&& "a=on"
|
||||
#!|| "a=off"
|
||||
#!>> fmtCmd myBluetooth ["power", "$a", ">", "/dev/null"]
|
||||
#!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "bluetooth powered $a" }
|
||||
|
||||
runToggleEthernet :: SometimesX
|
||||
runToggleEthernet = sometimesIO_ "ethernet toggle" "nmcli" (Only_ $ sysExe "nmcli")
|
||||
$ spawn
|
||||
$ "nmcli -g GENERAL.STATE device show " ++ ethernetIface ++ " | grep -q disconnected"
|
||||
#!&& "a=connect"
|
||||
#!|| "a=disconnect"
|
||||
#!>> fmtCmd "nmcli" ["device", "$a", ethernetIface]
|
||||
#!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "ethernet \"$a\"ed" }
|
||||
runToggleEthernet = sometimes1 "ethernet toggle" "nmcli" $ IORoot (spawn . cmd) $
|
||||
And1 (Only readEthernet) (Only_ $ sysExe "nmcli")
|
||||
where
|
||||
-- TODO make this less noisy
|
||||
cmd iface =
|
||||
"nmcli -g GENERAL.STATE device show " ++ iface ++ " | grep -q disconnected"
|
||||
#!&& "a=connect"
|
||||
#!|| "a=disconnect"
|
||||
#!>> fmtCmd "nmcli" ["device", "$a", iface]
|
||||
#!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "ethernet \"$a\"ed" }
|
||||
|
||||
runStartISyncTimer :: SometimesX
|
||||
runStartISyncTimer = sometimesIO_ "isync timer" "mbsync timer"
|
||||
|
|
|
@ -3,9 +3,14 @@
|
|||
|
||||
module XMonad.Internal.DBus.Common
|
||||
( xmonadBusName
|
||||
, btBus
|
||||
) where
|
||||
|
||||
import DBus
|
||||
|
||||
xmonadBusName :: BusName
|
||||
xmonadBusName = busName_ "org.xmonad"
|
||||
|
||||
btBus :: BusName
|
||||
btBus = busName_ "org.bluez"
|
||||
|
||||
|
|
|
@ -65,6 +65,8 @@ module XMonad.Internal.Dependency
|
|||
, fontTree_
|
||||
, fontAlways
|
||||
, fontSometimes
|
||||
, readEthernet
|
||||
, readWireless
|
||||
|
||||
-- lifting
|
||||
, ioSometimes
|
||||
|
@ -107,6 +109,7 @@ import Control.Monad.State
|
|||
import Data.Aeson hiding (Error, Result)
|
||||
import Data.Aeson.Key
|
||||
import Data.Bifunctor
|
||||
import Data.Either
|
||||
import qualified Data.HashMap.Strict as H
|
||||
import Data.Hashable
|
||||
import Data.List
|
||||
|
@ -124,6 +127,7 @@ import System.Directory
|
|||
import System.Environment
|
||||
import System.Exit
|
||||
import System.FilePath
|
||||
import System.IO.Error
|
||||
import System.Posix.Files
|
||||
|
||||
import XMonad.Core (X, io)
|
||||
|
@ -164,19 +168,24 @@ evalSometimes x = either goFail goPass =<< evalSometimesMsg x
|
|||
where
|
||||
goPass (a, ws) = putErrors ws >> return (Just a)
|
||||
goFail es = putErrors es >> return Nothing
|
||||
putErrors = io . mapM_ printMsg
|
||||
putErrors = mapM_ printMsg
|
||||
|
||||
-- | Return the action of an Always
|
||||
evalAlways :: Always a -> FIO a
|
||||
evalAlways a = do
|
||||
(x, ws) <- evalAlwaysMsg a
|
||||
io $ mapM_ printMsg ws
|
||||
mapM_ printMsg ws
|
||||
return x
|
||||
|
||||
printMsg :: FMsg -> IO ()
|
||||
printMsg :: FMsg -> FIO ()
|
||||
printMsg (FMsg fn n (Msg ll m)) = do
|
||||
p <- getProgName
|
||||
putStrLn $ unwords [bracket p, bracket $ show ll, bracket fn, bracket n, m]
|
||||
xl <- asks xpLogLevel
|
||||
p <- io getProgName
|
||||
io $ when (ll >= xl) $ putStrLn $ unwords [ bracket p
|
||||
, bracket $ show ll
|
||||
, bracket fn
|
||||
, bracket n, m
|
||||
]
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Feature status
|
||||
|
@ -723,6 +732,43 @@ testFont' fam = maybe pass (Left . (:[])) <$> shellTest cmd msg
|
|||
qFam = singleQuote fam
|
||||
pass = Right $ PostPass (buildFont $ Just fam) []
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | network dependencies
|
||||
--
|
||||
-- ASSUME that the system uses systemd in which case ethernet interfaces always
|
||||
-- start with "en" and wireless interfaces always start with "wl"
|
||||
|
||||
readEthernet :: IODependency String
|
||||
readEthernet = readInterface "get ethernet interface" isEthernet
|
||||
|
||||
readWireless :: IODependency String
|
||||
readWireless = readInterface "get wireless interface" isWireless
|
||||
|
||||
isWireless :: String -> Bool
|
||||
isWireless ('w':'l':_) = True
|
||||
isWireless _ = False
|
||||
|
||||
isEthernet :: String -> Bool
|
||||
isEthernet ('e':'n':_) = True
|
||||
isEthernet _ = False
|
||||
|
||||
listInterfaces :: IO [String]
|
||||
listInterfaces = fromRight [] <$> tryIOError (listDirectory sysfsNet)
|
||||
|
||||
sysfsNet :: FilePath
|
||||
sysfsNet = "/sys/class/net"
|
||||
|
||||
readInterface :: String -> (String -> Bool) -> IODependency String
|
||||
readInterface n f = IORead n go
|
||||
where
|
||||
go = io $ do
|
||||
ns <- filter f <$> listInterfaces
|
||||
case ns of
|
||||
[] -> return $ Left [Msg Error "no interfaces found"]
|
||||
(x:xs) -> do
|
||||
return $ Right $ PostPass x
|
||||
$ fmap (Msg Warn . ("ignoring extra interface: " ++)) xs
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | DBus Dependency Testing
|
||||
|
||||
|
|
|
@ -41,13 +41,14 @@ import Control.Monad
|
|||
|
||||
import Data.List
|
||||
import Data.List.Split
|
||||
import qualified Data.Map as M
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe
|
||||
|
||||
import DBus
|
||||
import DBus.Client
|
||||
import DBus.Internal
|
||||
|
||||
import XMonad.Internal.DBus.Common
|
||||
import XMonad.Internal.Dependency
|
||||
import Xmobar
|
||||
import Xmobar.Plugins.Common
|
||||
|
@ -158,9 +159,6 @@ splitPath = splitOn "/" . dropWhile (=='/') . formatObjectPath
|
|||
getBtObjectTree :: Client -> IO ObjectTree
|
||||
getBtObjectTree client = callGetManagedObjects client btBus btOMPath
|
||||
|
||||
btBus :: BusName
|
||||
btBus = busName_ "org.bluez"
|
||||
|
||||
btOMPath :: ObjectPath
|
||||
btOMPath = objectPath_ "/"
|
||||
|
||||
|
|
Loading…
Reference in New Issue