REF move dependency interface to own module/pull common code from intelbacklight
This commit is contained in:
parent
53279475f4
commit
76c0eb3386
|
@ -21,7 +21,9 @@ import System.Directory
|
||||||
import System.Exit
|
import System.Exit
|
||||||
import System.IO
|
import System.IO
|
||||||
import System.IO.Error
|
import System.IO.Error
|
||||||
import System.Process (readProcessWithExitCode)
|
import System.Process
|
||||||
|
( readProcessWithExitCode
|
||||||
|
)
|
||||||
|
|
||||||
import Xmobar.Plugins.Bluetooth
|
import Xmobar.Plugins.Bluetooth
|
||||||
import Xmobar.Plugins.ClevoKeyboard
|
import Xmobar.Plugins.ClevoKeyboard
|
||||||
|
@ -30,15 +32,18 @@ import Xmobar.Plugins.IntelBacklight
|
||||||
import Xmobar.Plugins.Screensaver
|
import Xmobar.Plugins.Screensaver
|
||||||
import Xmobar.Plugins.VPN
|
import Xmobar.Plugins.VPN
|
||||||
|
|
||||||
import XMonad (getXMonadDir)
|
import XMonad (getXMonadDir)
|
||||||
import XMonad.Hooks.DynamicLog (wrap, xmobarColor)
|
import XMonad.Hooks.DynamicLog
|
||||||
import XMonad.Internal.Command.Power (hasBattery)
|
( wrap
|
||||||
import XMonad.Internal.DBus.Common (xmonadBus)
|
, xmobarColor
|
||||||
import XMonad.Internal.DBus.Control (pathExists)
|
)
|
||||||
import XMonad.Internal.DBus.IntelBacklight (blPath)
|
import XMonad.Internal.Command.Power (hasBattery)
|
||||||
import XMonad.Internal.DBus.Screensaver (ssPath)
|
import XMonad.Internal.DBus.Brightness.IntelBacklight (blPath)
|
||||||
import XMonad.Internal.Shell (fmtCmd)
|
import XMonad.Internal.DBus.Common (xmonadBus)
|
||||||
import qualified XMonad.Internal.Theme as T
|
import XMonad.Internal.DBus.Control (pathExists)
|
||||||
|
import XMonad.Internal.DBus.Screensaver (ssPath)
|
||||||
|
import XMonad.Internal.Shell (fmtCmd)
|
||||||
|
import qualified XMonad.Internal.Theme as T
|
||||||
import Xmobar
|
import Xmobar
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
|
|
|
@ -44,9 +44,10 @@ import XMonad.Internal.Concurrent.ACPIEvent
|
||||||
import XMonad.Internal.Concurrent.ClientMessage
|
import XMonad.Internal.Concurrent.ClientMessage
|
||||||
import XMonad.Internal.Concurrent.DynamicWorkspaces
|
import XMonad.Internal.Concurrent.DynamicWorkspaces
|
||||||
import XMonad.Internal.Concurrent.Removable
|
import XMonad.Internal.Concurrent.Removable
|
||||||
|
import XMonad.Internal.DBus.Brightness.Common
|
||||||
import XMonad.Internal.DBus.Control
|
import XMonad.Internal.DBus.Control
|
||||||
import XMonad.Internal.DBus.IntelBacklight
|
|
||||||
import XMonad.Internal.DBus.Screensaver
|
import XMonad.Internal.DBus.Screensaver
|
||||||
|
import XMonad.Internal.Dependency
|
||||||
import XMonad.Internal.Process
|
import XMonad.Internal.Process
|
||||||
import XMonad.Internal.Shell
|
import XMonad.Internal.Shell
|
||||||
import qualified XMonad.Internal.Theme as T
|
import qualified XMonad.Internal.Theme as T
|
||||||
|
@ -66,7 +67,11 @@ import XMonad.Util.WorkspaceCompare
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
(cl, bc, sc) <- startXMonadService
|
DBusXMonad
|
||||||
|
{ dxClient = cl
|
||||||
|
, dxIntelBacklightCtrl = bc
|
||||||
|
, dxScreensaverCtrl = sc
|
||||||
|
} <- startXMonadService
|
||||||
(h, p) <- spawnPipe "xmobar"
|
(h, p) <- spawnPipe "xmobar"
|
||||||
_ <- forkIO runPowermon
|
_ <- forkIO runPowermon
|
||||||
_ <- forkIO runRemovableMon
|
_ <- forkIO runRemovableMon
|
||||||
|
@ -485,7 +490,7 @@ filterExternal kgs = let kgs' = fmap go kgs in (fst <$> kgs', concatMap snd kgs'
|
||||||
Ignore -> (Nothing, [])
|
Ignore -> (Nothing, [])
|
||||||
flagMissing s = "[!!!]" ++ s
|
flagMissing s = "[!!!]" ++ s
|
||||||
|
|
||||||
externalBindings :: Maybe BacklightControls
|
externalBindings :: Maybe BrightnessControls
|
||||||
-> MaybeExe SSControls
|
-> MaybeExe SSControls
|
||||||
-> ThreadState
|
-> ThreadState
|
||||||
-> [KeyGroup (IO MaybeX)]
|
-> [KeyGroup (IO MaybeX)]
|
||||||
|
@ -534,10 +539,10 @@ externalBindings bc sc ts =
|
||||||
]
|
]
|
||||||
|
|
||||||
, KeyGroup "System"
|
, KeyGroup "System"
|
||||||
[ KeyBinding "M-." "backlight up" $ runMaybe bc backlightUp
|
[ KeyBinding "M-." "backlight up" $ runMaybe bc bctlInc
|
||||||
, KeyBinding "M-," "backlight down" $ runMaybe bc backlightDown
|
, KeyBinding "M-," "backlight down" $ runMaybe bc bctlDec
|
||||||
, KeyBinding "M-M1-," "backlight min" $ runMaybe bc backlightMin
|
, KeyBinding "M-M1-," "backlight min" $ runMaybe bc bctlMin
|
||||||
, KeyBinding "M-M1-." "backlight max" $ runMaybe bc backlightMax
|
, KeyBinding "M-M1-." "backlight max" $ runMaybe bc bctlMax
|
||||||
, KeyBinding "M-<End>" "power menu" $ noCheck runPowerPrompt
|
, KeyBinding "M-<End>" "power menu" $ noCheck runPowerPrompt
|
||||||
, KeyBinding "M-<Home>" "quit xmonad" $ noCheck runQuitPrompt
|
, KeyBinding "M-<Home>" "quit xmonad" $ noCheck runQuitPrompt
|
||||||
, KeyBinding "M-<Delete>" "lock screen" runScreenLock
|
, KeyBinding "M-<Delete>" "lock screen" runScreenLock
|
||||||
|
|
|
@ -17,13 +17,13 @@ import Control.Monad.Reader
|
||||||
|
|
||||||
import Graphics.X11.Types
|
import Graphics.X11.Types
|
||||||
|
|
||||||
import System.Directory (XdgDirectory (..), getXdgDirectory)
|
import System.Directory (XdgDirectory (..), getXdgDirectory)
|
||||||
import System.IO
|
import System.IO
|
||||||
|
|
||||||
import XMonad.Core hiding (spawn)
|
import XMonad.Core hiding (spawn)
|
||||||
|
import XMonad.Internal.Dependency
|
||||||
import XMonad.Internal.Notify
|
import XMonad.Internal.Notify
|
||||||
import XMonad.Internal.Process
|
import XMonad.Internal.Process
|
||||||
import XMonad.Internal.Shell
|
|
||||||
import XMonad.Util.NamedActions
|
import XMonad.Util.NamedActions
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
|
|
|
@ -45,9 +45,9 @@ import System.FilePath
|
||||||
import XMonad.Actions.Volume
|
import XMonad.Actions.Volume
|
||||||
import XMonad.Core hiding (spawn)
|
import XMonad.Core hiding (spawn)
|
||||||
import XMonad.Internal.DBus.Screensaver
|
import XMonad.Internal.DBus.Screensaver
|
||||||
|
import XMonad.Internal.Dependency
|
||||||
import XMonad.Internal.Notify
|
import XMonad.Internal.Notify
|
||||||
import XMonad.Internal.Process
|
import XMonad.Internal.Process
|
||||||
import XMonad.Internal.Shell
|
|
||||||
import XMonad.Operations
|
import XMonad.Operations
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
|
|
|
@ -28,8 +28,8 @@ import System.IO.Error
|
||||||
import System.Process
|
import System.Process
|
||||||
|
|
||||||
import XMonad.Core
|
import XMonad.Core
|
||||||
|
import XMonad.Internal.Dependency
|
||||||
import XMonad.Internal.Process (readCreateProcessWithExitCode')
|
import XMonad.Internal.Process (readCreateProcessWithExitCode')
|
||||||
import XMonad.Internal.Shell
|
|
||||||
import qualified XMonad.Internal.Theme as T
|
import qualified XMonad.Internal.Theme as T
|
||||||
import XMonad.Prompt
|
import XMonad.Prompt
|
||||||
import XMonad.Prompt.ConfirmPrompt
|
import XMonad.Prompt.ConfirmPrompt
|
||||||
|
|
|
@ -25,7 +25,7 @@ import System.IO.Streams.UnixSocket
|
||||||
import XMonad.Core
|
import XMonad.Core
|
||||||
import XMonad.Internal.Command.Power
|
import XMonad.Internal.Command.Power
|
||||||
import XMonad.Internal.Concurrent.ClientMessage
|
import XMonad.Internal.Concurrent.ClientMessage
|
||||||
import XMonad.Internal.Shell
|
import XMonad.Internal.Dependency
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Data structure to hold the ACPI events I care about
|
-- | Data structure to hold the ACPI events I care about
|
||||||
|
|
|
@ -15,7 +15,7 @@ import DBus
|
||||||
import DBus.Client
|
import DBus.Client
|
||||||
|
|
||||||
import XMonad.Internal.DBus.Control (pathExists)
|
import XMonad.Internal.DBus.Control (pathExists)
|
||||||
import XMonad.Internal.Shell
|
import XMonad.Internal.Dependency
|
||||||
|
|
||||||
bus :: BusName
|
bus :: BusName
|
||||||
bus = busName_ "org.freedesktop.UDisks2"
|
bus = busName_ "org.freedesktop.UDisks2"
|
||||||
|
|
|
@ -0,0 +1,128 @@
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | DBus module for DBus brightness controls
|
||||||
|
|
||||||
|
module XMonad.Internal.DBus.Brightness.Common
|
||||||
|
( BrightnessConfig(..)
|
||||||
|
, BrightnessControls(..)
|
||||||
|
, exportBrightnessControls
|
||||||
|
, callGetBrightness
|
||||||
|
, matchSignal
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Control.Monad (void)
|
||||||
|
|
||||||
|
import Data.Int (Int32)
|
||||||
|
|
||||||
|
import DBus
|
||||||
|
import DBus.Client
|
||||||
|
|
||||||
|
import XMonad.Internal.DBus.Common
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | External API
|
||||||
|
--
|
||||||
|
-- Define four methods to increase, decrease, maximize, or minimize the
|
||||||
|
-- brightness. These methods will all return the current brightness as a 32-bit
|
||||||
|
-- integer and emit a signal with the same brightness value. Additionally, there
|
||||||
|
-- is one method to get the current brightness.
|
||||||
|
|
||||||
|
data BrightnessConfig a b = BrightnessConfig
|
||||||
|
{ bcMin :: a -> IO b
|
||||||
|
, bcMax :: a -> IO b
|
||||||
|
, bcDec :: a -> IO b
|
||||||
|
, bcInc :: a -> IO b
|
||||||
|
, bcGet :: a -> IO b
|
||||||
|
, bcGetMax :: IO a
|
||||||
|
, bcPath :: ObjectPath
|
||||||
|
, bcInterface :: InterfaceName
|
||||||
|
}
|
||||||
|
|
||||||
|
data BrightnessControls = BrightnessControls
|
||||||
|
{ bctlMax :: IO ()
|
||||||
|
, bctlMin :: IO ()
|
||||||
|
, bctlInc :: IO ()
|
||||||
|
, bctlDec :: IO ()
|
||||||
|
}
|
||||||
|
|
||||||
|
exportBrightnessControls :: RealFrac b => BrightnessConfig a b -> Client
|
||||||
|
-> IO BrightnessControls
|
||||||
|
exportBrightnessControls bc client = do
|
||||||
|
exportBrightnessControls' bc client
|
||||||
|
return $ BrightnessControls
|
||||||
|
{ bctlMax = callBacklight' memMax
|
||||||
|
, bctlMin = callBacklight' memMin
|
||||||
|
, bctlInc = callBacklight' memInc
|
||||||
|
, bctlDec = callBacklight' memDec
|
||||||
|
}
|
||||||
|
where
|
||||||
|
callBacklight' = callBacklight bc
|
||||||
|
|
||||||
|
callGetBrightness :: Num c => BrightnessConfig a b -> IO (Maybe c)
|
||||||
|
callGetBrightness BrightnessConfig { bcPath = p, bcInterface = i } = do
|
||||||
|
reply <- callMethod $ methodCall p i memGet
|
||||||
|
return $ reply >>= bodyGetBrightness
|
||||||
|
|
||||||
|
matchSignal :: Num c => BrightnessConfig a b -> (Maybe c -> IO ()) -> IO SignalHandler
|
||||||
|
matchSignal BrightnessConfig { bcPath = p, bcInterface = i } cb = do
|
||||||
|
client <- connectSession
|
||||||
|
addMatch client brMatcher $ cb . bodyGetBrightness . signalBody
|
||||||
|
where
|
||||||
|
brMatcher = matchAny
|
||||||
|
{ matchPath = Just p
|
||||||
|
, matchInterface = Just i
|
||||||
|
, matchMember = Just memCur
|
||||||
|
}
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | Internal DBus Crap
|
||||||
|
|
||||||
|
exportBrightnessControls' :: RealFrac b => BrightnessConfig a b -> Client -> IO ()
|
||||||
|
exportBrightnessControls' bc client = do
|
||||||
|
maxval <- bcGetMax bc -- assume the max value will never change
|
||||||
|
let autoMethod' m f = autoMethod m $ emitBrightness bc client =<< f bc maxval
|
||||||
|
let funget = bcGet bc
|
||||||
|
export client (bcPath bc) defaultInterface
|
||||||
|
{ interfaceName = bcInterface bc
|
||||||
|
, interfaceMethods =
|
||||||
|
[ autoMethod' memMax bcMax
|
||||||
|
, autoMethod' memMin bcMin
|
||||||
|
, autoMethod' memInc bcInc
|
||||||
|
, autoMethod' memDec bcDec
|
||||||
|
, autoMethod memGet (round <$> funget maxval :: IO Int32)
|
||||||
|
]
|
||||||
|
}
|
||||||
|
|
||||||
|
emitBrightness :: RealFrac b => BrightnessConfig a b -> Client -> b -> IO ()
|
||||||
|
emitBrightness BrightnessConfig{ bcPath = p, bcInterface = i } client cur =
|
||||||
|
emit client $ sig { signalBody = [toVariant (round cur :: Int32)] }
|
||||||
|
where
|
||||||
|
sig = signal p i memCur
|
||||||
|
|
||||||
|
callBacklight :: BrightnessConfig a b -> MemberName -> IO ()
|
||||||
|
callBacklight BrightnessConfig { bcPath = p, bcInterface = i } mem =
|
||||||
|
void $ callMethod $ methodCall p i mem
|
||||||
|
|
||||||
|
bodyGetBrightness :: Num a => [Variant] -> Maybe a
|
||||||
|
bodyGetBrightness [b] = fromIntegral <$> (fromVariant b :: Maybe Int32)
|
||||||
|
bodyGetBrightness _ = Nothing
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | DBus Members
|
||||||
|
|
||||||
|
memCur :: MemberName
|
||||||
|
memCur = memberName_ "CurrentBrightness"
|
||||||
|
|
||||||
|
memGet :: MemberName
|
||||||
|
memGet = memberName_ "GetBrightness"
|
||||||
|
|
||||||
|
memMax :: MemberName
|
||||||
|
memMax = memberName_ "MaxBrightness"
|
||||||
|
|
||||||
|
memMin :: MemberName
|
||||||
|
memMin = memberName_ "MinBrightness"
|
||||||
|
|
||||||
|
memInc :: MemberName
|
||||||
|
memInc = memberName_ "IncBrightness"
|
||||||
|
|
||||||
|
memDec :: MemberName
|
||||||
|
memDec = memberName_ "DecBrightness"
|
|
@ -0,0 +1,126 @@
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | DBus module for Intel Backlight control
|
||||||
|
|
||||||
|
module XMonad.Internal.DBus.Brightness.IntelBacklight
|
||||||
|
( callGetBrightnessIB
|
||||||
|
, matchSignalIB
|
||||||
|
, exportIntelBacklight
|
||||||
|
, hasBacklight
|
||||||
|
, blPath
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Data.Either
|
||||||
|
import Data.Int (Int32)
|
||||||
|
|
||||||
|
import DBus
|
||||||
|
import DBus.Client
|
||||||
|
|
||||||
|
import System.FilePath.Posix
|
||||||
|
|
||||||
|
import XMonad.Internal.DBus.Brightness.Common
|
||||||
|
import XMonad.Internal.IO
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | Low level sysfs functions
|
||||||
|
--
|
||||||
|
type Brightness = Float
|
||||||
|
|
||||||
|
type RawBrightness = Int32
|
||||||
|
|
||||||
|
steps :: Int
|
||||||
|
steps = 16
|
||||||
|
|
||||||
|
backlightDir :: FilePath
|
||||||
|
backlightDir = "/sys/class/backlight/intel_backlight/"
|
||||||
|
|
||||||
|
maxFile :: FilePath
|
||||||
|
maxFile = backlightDir </> "max_brightness"
|
||||||
|
|
||||||
|
curFile :: FilePath
|
||||||
|
curFile = backlightDir </> "brightness"
|
||||||
|
|
||||||
|
getMaxRawBrightness :: IO RawBrightness
|
||||||
|
getMaxRawBrightness = readInt maxFile
|
||||||
|
|
||||||
|
getBrightness :: RawBrightness -> IO Brightness
|
||||||
|
getBrightness upper = readPercent upper curFile
|
||||||
|
|
||||||
|
minBrightness :: RawBrightness -> IO Brightness
|
||||||
|
minBrightness upper = writePercentMin upper curFile
|
||||||
|
|
||||||
|
maxBrightness :: RawBrightness -> IO Brightness
|
||||||
|
maxBrightness upper = writePercentMax upper curFile
|
||||||
|
|
||||||
|
incBrightness :: RawBrightness -> IO Brightness
|
||||||
|
incBrightness = incPercent steps curFile
|
||||||
|
|
||||||
|
decBrightness :: RawBrightness -> IO Brightness
|
||||||
|
decBrightness = decPercent steps curFile
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | 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 <- isReadable maxFile
|
||||||
|
cx <- isWritable curFile
|
||||||
|
return $ case (mx, cx) of
|
||||||
|
(NotFoundError, NotFoundError) -> Right False
|
||||||
|
(PermResult True, PermResult True) -> Right True
|
||||||
|
(PermResult _, PermResult _) -> Left "Insufficient permissions for backlight files"
|
||||||
|
_ -> Left "Could not determine permissions for backlight files"
|
||||||
|
|
||||||
|
msg :: Either String Bool -> IO ()
|
||||||
|
msg (Right True) = return ()
|
||||||
|
msg (Right False) = putStrLn "No backlight detected. Controls disabled"
|
||||||
|
msg (Left m) = putStrLn $ "WARNING: " ++ m
|
||||||
|
|
||||||
|
hasBacklightMsg :: IO Bool
|
||||||
|
hasBacklightMsg = do
|
||||||
|
b <- hasBacklight'
|
||||||
|
msg b
|
||||||
|
return $ fromRight False b
|
||||||
|
|
||||||
|
hasBacklight :: IO Bool
|
||||||
|
hasBacklight = fromRight False <$> hasBacklight'
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | DBus interface
|
||||||
|
|
||||||
|
blPath :: ObjectPath
|
||||||
|
blPath = objectPath_ "/intelbacklight"
|
||||||
|
|
||||||
|
interface :: InterfaceName
|
||||||
|
interface = interfaceName_ "org.xmonad.Brightness"
|
||||||
|
|
||||||
|
intelBacklightConfig :: BrightnessConfig RawBrightness Brightness
|
||||||
|
intelBacklightConfig = BrightnessConfig
|
||||||
|
{ bcMin = minBrightness
|
||||||
|
, bcMax = maxBrightness
|
||||||
|
, bcInc = incBrightness
|
||||||
|
, bcDec = decBrightness
|
||||||
|
, bcGet = getBrightness
|
||||||
|
, bcGetMax = getMaxRawBrightness
|
||||||
|
, bcPath = blPath
|
||||||
|
, bcInterface = interface
|
||||||
|
}
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | Exported haskell API
|
||||||
|
|
||||||
|
exportIntelBacklight :: Client -> IO (Maybe BrightnessControls)
|
||||||
|
exportIntelBacklight client = do
|
||||||
|
b <- hasBacklightMsg
|
||||||
|
if b
|
||||||
|
then Just <$> exportBrightnessControls intelBacklightConfig client
|
||||||
|
else return Nothing
|
||||||
|
|
||||||
|
callGetBrightnessIB :: IO (Maybe Brightness)
|
||||||
|
callGetBrightnessIB = callGetBrightness intelBacklightConfig
|
||||||
|
|
||||||
|
matchSignalIB :: (Maybe Brightness -> IO ()) -> IO SignalHandler
|
||||||
|
matchSignalIB = matchSignal intelBacklightConfig
|
|
@ -9,6 +9,7 @@ module XMonad.Internal.DBus.Control
|
||||||
, stopXMonadService
|
, stopXMonadService
|
||||||
, pathExists
|
, pathExists
|
||||||
, xmonadBus
|
, xmonadBus
|
||||||
|
, DBusXMonad(..)
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Data.Either
|
import Data.Either
|
||||||
|
@ -16,10 +17,11 @@ import Data.Either
|
||||||
import DBus
|
import DBus
|
||||||
import DBus.Client
|
import DBus.Client
|
||||||
|
|
||||||
|
import XMonad.Internal.DBus.Brightness.Common
|
||||||
|
import XMonad.Internal.DBus.Brightness.IntelBacklight
|
||||||
import XMonad.Internal.DBus.Common
|
import XMonad.Internal.DBus.Common
|
||||||
import XMonad.Internal.DBus.IntelBacklight
|
|
||||||
import XMonad.Internal.DBus.Screensaver
|
import XMonad.Internal.DBus.Screensaver
|
||||||
import XMonad.Internal.Shell
|
import XMonad.Internal.Dependency
|
||||||
|
|
||||||
introspectInterface :: InterfaceName
|
introspectInterface :: InterfaceName
|
||||||
introspectInterface = interfaceName_ "org.freedesktop.DBus.Introspectable"
|
introspectInterface = interfaceName_ "org.freedesktop.DBus.Introspectable"
|
||||||
|
@ -27,20 +29,33 @@ introspectInterface = interfaceName_ "org.freedesktop.DBus.Introspectable"
|
||||||
introspectMethod :: MemberName
|
introspectMethod :: MemberName
|
||||||
introspectMethod = memberName_ "Introspect"
|
introspectMethod = memberName_ "Introspect"
|
||||||
|
|
||||||
startXMonadService :: IO (Client, Maybe BacklightControls, MaybeExe SSControls)
|
data DBusXMonad = DBusXMonad
|
||||||
|
{ dxClient :: Client
|
||||||
|
, dxIntelBacklightCtrl :: Maybe BrightnessControls
|
||||||
|
, dxClevoBacklightCtrl :: Maybe BrightnessControls
|
||||||
|
, dxScreensaverCtrl :: MaybeExe SSControls
|
||||||
|
}
|
||||||
|
|
||||||
|
startXMonadService :: IO DBusXMonad
|
||||||
startXMonadService = do
|
startXMonadService = do
|
||||||
client <- connectSession
|
client <- connectSession
|
||||||
requestResult <- requestName client xmonadBus []
|
requestResult <- requestName client xmonadBus []
|
||||||
-- TODO if the client is not released on shutdown the owner will be
|
-- TODO if the client is not released on shutdown the owner will be
|
||||||
-- different
|
-- different
|
||||||
if requestResult /= NamePrimaryOwner then do
|
(i, c, s) <- if requestResult /= NamePrimaryOwner then do
|
||||||
putStrLn "Another service owns \"org.xmonad\""
|
putStrLn "Another service owns \"org.xmonad\""
|
||||||
return (client, Nothing, Ignore)
|
return (Nothing, Nothing, Ignore)
|
||||||
else do
|
else do
|
||||||
putStrLn "Started xmonad dbus client"
|
putStrLn "Started xmonad dbus client"
|
||||||
bc <- exportIntelBacklight client
|
bc <- exportIntelBacklight client
|
||||||
sc <- exportScreensaver client
|
sc <- exportScreensaver client
|
||||||
return (client, bc, sc)
|
return (bc, Nothing, sc)
|
||||||
|
return $ DBusXMonad
|
||||||
|
{ dxClient = client
|
||||||
|
, dxIntelBacklightCtrl = i
|
||||||
|
, dxClevoBacklightCtrl = c
|
||||||
|
, dxScreensaverCtrl = s
|
||||||
|
}
|
||||||
|
|
||||||
stopXMonadService :: Client -> IO ()
|
stopXMonadService :: Client -> IO ()
|
||||||
stopXMonadService client = do
|
stopXMonadService client = do
|
||||||
|
|
|
@ -1,205 +0,0 @@
|
||||||
--------------------------------------------------------------------------------
|
|
||||||
-- | DBus module for Intel Backlight control
|
|
||||||
|
|
||||||
module XMonad.Internal.DBus.IntelBacklight
|
|
||||||
( callGetBrightness
|
|
||||||
, exportIntelBacklight
|
|
||||||
, matchSignal
|
|
||||||
, hasBacklight
|
|
||||||
, blPath
|
|
||||||
, BacklightControls(..)
|
|
||||||
) where
|
|
||||||
|
|
||||||
import Control.Monad (void)
|
|
||||||
|
|
||||||
import Data.Either
|
|
||||||
import Data.Int (Int32)
|
|
||||||
|
|
||||||
import DBus
|
|
||||||
import DBus.Client
|
|
||||||
|
|
||||||
import System.FilePath.Posix
|
|
||||||
|
|
||||||
import XMonad.Internal.DBus.Common
|
|
||||||
import XMonad.Internal.IO
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
|
||||||
-- | Low level sysfs functions
|
|
||||||
--
|
|
||||||
type Brightness = Float
|
|
||||||
|
|
||||||
type RawBrightness = Int32
|
|
||||||
|
|
||||||
steps :: Int
|
|
||||||
steps = 16
|
|
||||||
|
|
||||||
backlightDir :: FilePath
|
|
||||||
backlightDir = "/sys/class/backlight/intel_backlight/"
|
|
||||||
|
|
||||||
maxFile :: FilePath
|
|
||||||
maxFile = backlightDir </> "max_brightness"
|
|
||||||
|
|
||||||
curFile :: FilePath
|
|
||||||
curFile = backlightDir </> "brightness"
|
|
||||||
|
|
||||||
getMaxRawBrightness :: IO RawBrightness
|
|
||||||
getMaxRawBrightness = readInt maxFile
|
|
||||||
|
|
||||||
getBrightness :: RawBrightness -> IO Brightness
|
|
||||||
getBrightness upper = readPercent upper curFile
|
|
||||||
|
|
||||||
minBrightness :: RawBrightness -> IO Brightness
|
|
||||||
minBrightness upper = writePercentMin upper curFile
|
|
||||||
|
|
||||||
maxBrightness :: RawBrightness -> IO Brightness
|
|
||||||
maxBrightness upper = writePercentMax upper curFile
|
|
||||||
|
|
||||||
incBrightness :: RawBrightness -> IO Brightness
|
|
||||||
incBrightness = incPercent steps curFile
|
|
||||||
|
|
||||||
decBrightness :: RawBrightness -> IO Brightness
|
|
||||||
decBrightness = decPercent steps curFile
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
|
||||||
-- | 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 <- isReadable maxFile
|
|
||||||
cx <- isWritable curFile
|
|
||||||
return $ case (mx, cx) of
|
|
||||||
(NotFoundError, NotFoundError) -> Right False
|
|
||||||
(PermResult True, PermResult True) -> Right True
|
|
||||||
(PermResult _, PermResult _) -> Left "Insufficient permissions for backlight files"
|
|
||||||
_ -> Left "Could not determine permissions for backlight files"
|
|
||||||
|
|
||||||
msg :: Either String Bool -> IO ()
|
|
||||||
msg (Right True) = return ()
|
|
||||||
msg (Right False) = putStrLn "No backlight detected. Controls disabled"
|
|
||||||
msg (Left m) = putStrLn $ "WARNING: " ++ m
|
|
||||||
|
|
||||||
hasBacklightMsg :: IO Bool
|
|
||||||
hasBacklightMsg = do
|
|
||||||
b <- hasBacklight'
|
|
||||||
msg b
|
|
||||||
return $ fromRight False b
|
|
||||||
|
|
||||||
hasBacklight :: IO Bool
|
|
||||||
hasBacklight = fromRight False <$> hasBacklight'
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
|
||||||
-- | DBus interface
|
|
||||||
--
|
|
||||||
-- Define four methods to increase, decrease, maximize, or minimize the
|
|
||||||
-- brightness. These methods will all return the current brightness as a 32-bit
|
|
||||||
-- integer and emit a signal with the same brightness value. Additionally, there
|
|
||||||
-- is one method to get the current brightness.
|
|
||||||
|
|
||||||
blPath :: ObjectPath
|
|
||||||
blPath = objectPath_ "/intelbacklight"
|
|
||||||
|
|
||||||
interface :: InterfaceName
|
|
||||||
interface = interfaceName_ "org.xmonad.Brightness"
|
|
||||||
|
|
||||||
memCurrentBrightness :: MemberName
|
|
||||||
memCurrentBrightness = memberName_ "CurrentBrightness"
|
|
||||||
|
|
||||||
memGetBrightness :: MemberName
|
|
||||||
memGetBrightness = memberName_ "GetBrightness"
|
|
||||||
|
|
||||||
memMaxBrightness :: MemberName
|
|
||||||
memMaxBrightness = memberName_ "MaxBrightness"
|
|
||||||
|
|
||||||
memMinBrightness :: MemberName
|
|
||||||
memMinBrightness = memberName_ "MinBrightness"
|
|
||||||
|
|
||||||
memIncBrightness :: MemberName
|
|
||||||
memIncBrightness = memberName_ "IncBrightness"
|
|
||||||
|
|
||||||
memDecBrightness :: MemberName
|
|
||||||
memDecBrightness = memberName_ "DecBrightness"
|
|
||||||
|
|
||||||
brSignal :: Signal
|
|
||||||
brSignal = signal blPath interface memCurrentBrightness
|
|
||||||
-- { signalDestination = Just "org.xmonad" }
|
|
||||||
|
|
||||||
brMatcher :: MatchRule
|
|
||||||
brMatcher = matchAny
|
|
||||||
{ matchPath = Just blPath
|
|
||||||
, matchInterface = Just interface
|
|
||||||
, matchMember = Just memCurrentBrightness
|
|
||||||
}
|
|
||||||
|
|
||||||
callBacklight :: MemberName -> IO ()
|
|
||||||
callBacklight method = void $ callMethod $ methodCall blPath interface method
|
|
||||||
|
|
||||||
bodyGetBrightness :: [Variant] -> Maybe Brightness
|
|
||||||
bodyGetBrightness [b] = fromIntegral <$> (fromVariant b :: Maybe Int32)
|
|
||||||
bodyGetBrightness _ = Nothing
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
|
||||||
-- | Exported haskell API
|
|
||||||
|
|
||||||
data BacklightControls = BacklightControls
|
|
||||||
{ backlightMax :: IO ()
|
|
||||||
, backlightMin :: IO ()
|
|
||||||
, backlightUp :: IO ()
|
|
||||||
, backlightDown :: IO ()
|
|
||||||
}
|
|
||||||
|
|
||||||
exportIntelBacklight :: Client -> IO (Maybe BacklightControls)
|
|
||||||
exportIntelBacklight client = do
|
|
||||||
b <- hasBacklightMsg
|
|
||||||
if b then exportIntelBacklight' client >> return (Just bc) else return Nothing
|
|
||||||
where
|
|
||||||
bc = BacklightControls
|
|
||||||
{ backlightMax = callMaxBrightness
|
|
||||||
, backlightMin = callMinBrightness
|
|
||||||
, backlightUp = callIncBrightness
|
|
||||||
, backlightDown = callDecBrightness
|
|
||||||
}
|
|
||||||
|
|
||||||
exportIntelBacklight' :: Client -> IO ()
|
|
||||||
exportIntelBacklight' client = do
|
|
||||||
maxval <- getMaxRawBrightness -- assume the max value will never change
|
|
||||||
let emit' f = emitBrightness client =<< f maxval
|
|
||||||
export client blPath defaultInterface
|
|
||||||
{ interfaceName = interface
|
|
||||||
, interfaceMethods =
|
|
||||||
[ autoMethod memMaxBrightness $ emit' maxBrightness
|
|
||||||
, autoMethod memMinBrightness $ emit' minBrightness
|
|
||||||
, autoMethod memIncBrightness $ emit' incBrightness
|
|
||||||
, autoMethod memDecBrightness $ emit' decBrightness
|
|
||||||
, autoMethod memGetBrightness (round <$> getBrightness maxval :: IO Int32)
|
|
||||||
]
|
|
||||||
}
|
|
||||||
|
|
||||||
emitBrightness :: Client -> Brightness -> IO ()
|
|
||||||
emitBrightness client cur = emit client
|
|
||||||
$ brSignal { signalBody = [toVariant (round cur :: Int32)] }
|
|
||||||
|
|
||||||
callMaxBrightness :: IO ()
|
|
||||||
callMaxBrightness = callBacklight memMaxBrightness
|
|
||||||
|
|
||||||
callMinBrightness :: IO ()
|
|
||||||
callMinBrightness = callBacklight memMinBrightness
|
|
||||||
|
|
||||||
callIncBrightness :: IO ()
|
|
||||||
callIncBrightness = callBacklight memIncBrightness
|
|
||||||
|
|
||||||
callDecBrightness :: IO ()
|
|
||||||
callDecBrightness = callBacklight memDecBrightness
|
|
||||||
|
|
||||||
callGetBrightness :: IO (Maybe Brightness)
|
|
||||||
callGetBrightness = do
|
|
||||||
reply <- callMethod $ methodCall blPath interface memGetBrightness
|
|
||||||
return $ reply >>= bodyGetBrightness
|
|
||||||
|
|
||||||
matchSignal :: (Maybe Brightness -> IO ()) -> IO SignalHandler
|
|
||||||
matchSignal cb = do
|
|
||||||
client <- connectSession
|
|
||||||
addMatch client brMatcher $ cb . bodyGetBrightness . signalBody
|
|
|
@ -19,8 +19,8 @@ import Graphics.X11.XScreenSaver
|
||||||
import Graphics.X11.Xlib.Display
|
import Graphics.X11.Xlib.Display
|
||||||
|
|
||||||
import XMonad.Internal.DBus.Common
|
import XMonad.Internal.DBus.Common
|
||||||
|
import XMonad.Internal.Dependency
|
||||||
import XMonad.Internal.Process
|
import XMonad.Internal.Process
|
||||||
import XMonad.Internal.Shell
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Low-level functions
|
-- | Low-level functions
|
||||||
|
|
|
@ -0,0 +1,177 @@
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | Functions for handling dependencies
|
||||||
|
|
||||||
|
module XMonad.Internal.Dependency
|
||||||
|
( MaybeExe(..)
|
||||||
|
, UnitType(..)
|
||||||
|
, Dependency(..)
|
||||||
|
, MaybeX
|
||||||
|
, exe
|
||||||
|
, systemUnit
|
||||||
|
, userUnit
|
||||||
|
, runIfInstalled
|
||||||
|
, depInstalled
|
||||||
|
, warnMissing
|
||||||
|
, whenInstalled
|
||||||
|
, ifInstalled
|
||||||
|
, spawnIfInstalled
|
||||||
|
, spawnCmdIfInstalled
|
||||||
|
, noCheck
|
||||||
|
, fmtCmd
|
||||||
|
, spawnCmd
|
||||||
|
, doubleQuote
|
||||||
|
, singleQuote
|
||||||
|
, (#!&&)
|
||||||
|
, (#!||)
|
||||||
|
, (#!|)
|
||||||
|
, (#!>>)
|
||||||
|
, playSound
|
||||||
|
, spawnSound
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Control.Monad (filterM)
|
||||||
|
import Control.Monad.IO.Class
|
||||||
|
|
||||||
|
import Data.Maybe (isJust)
|
||||||
|
|
||||||
|
-- import System.Directory (findExecutable, readable, writable)
|
||||||
|
import System.Directory (findExecutable)
|
||||||
|
import System.Exit
|
||||||
|
import System.FilePath
|
||||||
|
|
||||||
|
import XMonad.Core (X, getXMonadDir)
|
||||||
|
-- import XMonad.Internal.IO
|
||||||
|
import XMonad.Internal.Process
|
||||||
|
import XMonad.Internal.Shell
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | Gracefully handling missing binaries
|
||||||
|
|
||||||
|
data UnitType = SystemUnit | UserUnit deriving (Eq, Show)
|
||||||
|
|
||||||
|
data DependencyType = Executable
|
||||||
|
-- | AccessiblePath FilePath Bool Bool
|
||||||
|
| 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
|
||||||
|
|
||||||
|
instance Functor MaybeExe where
|
||||||
|
fmap f (Installed x ds) = Installed (f x) ds
|
||||||
|
fmap _ (Missing x) = Missing x
|
||||||
|
fmap _ Ignore = Ignore
|
||||||
|
|
||||||
|
type MaybeX = MaybeExe (X ())
|
||||||
|
|
||||||
|
warnMissing :: Dependency -> IO ()
|
||||||
|
warnMissing Dependency {depRequired = r, depName = n, depType = t } =
|
||||||
|
putStrLn $ "WARNING: " ++ r' ++ " " ++ fmtType t ++ " not found: " ++ n
|
||||||
|
where
|
||||||
|
fmtType Executable = "executable"
|
||||||
|
-- fmtType (AccessiblePath _ _ _) = undefined
|
||||||
|
fmtType (Systemd UserUnit) = "systemd user unit"
|
||||||
|
fmtType (Systemd SystemUnit) = "systemd system unit"
|
||||||
|
r' = if r then "required" else "optional"
|
||||||
|
|
||||||
|
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]
|
||||||
|
|
||||||
|
-- pathAccessible :: FilePath -> Bool -> Bool -> IO (Maybe String)
|
||||||
|
-- pathAccessible p testread testwrite = do
|
||||||
|
-- res <- getPermissionsSafe p
|
||||||
|
-- let msg = permMsg res
|
||||||
|
-- return $ fmap (\m -> m ++ ": " ++ p) msg
|
||||||
|
-- where
|
||||||
|
-- testPerm False _ _ = Nothing
|
||||||
|
-- testPerm True f r = Just $ f r
|
||||||
|
-- permMsg NotFoundError = Just "file not found"
|
||||||
|
-- permMsg PermError = Just "could not get permissions"
|
||||||
|
-- permMsg (PermResult r) =
|
||||||
|
-- case (testPerm testread readable r, testPerm testwrite writable r) of
|
||||||
|
-- (Just False, Just False) -> Just "file not readable or writable"
|
||||||
|
-- (Just False, _) -> Just "file not readable"
|
||||||
|
-- (_, Just False) -> Just "file not writable"
|
||||||
|
-- _ -> Nothing
|
||||||
|
|
||||||
|
depInstalled :: Dependency -> IO Bool
|
||||||
|
depInstalled Dependency { depName = n, depType = t } =
|
||||||
|
case t of
|
||||||
|
Executable -> exeInstalled n
|
||||||
|
-- (AccessiblePath p r w) -> pathAccessible p r w
|
||||||
|
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
|
||||||
|
|
||||||
|
spawnIfInstalled :: MonadIO m => String -> IO (MaybeExe (m ()))
|
||||||
|
spawnIfInstalled n = runIfInstalled [exe n] $ spawn n
|
||||||
|
|
||||||
|
spawnCmdIfInstalled :: MonadIO m => String -> [String] -> IO (MaybeExe (m ()))
|
||||||
|
spawnCmdIfInstalled n args = runIfInstalled [exe n] $ spawnCmd n args
|
||||||
|
|
||||||
|
whenInstalled :: Monad m => MaybeExe (m ()) -> m ()
|
||||||
|
whenInstalled = flip ifInstalled skip
|
||||||
|
|
||||||
|
ifInstalled :: MaybeExe a -> a -> a
|
||||||
|
ifInstalled (Installed x _) _ = x
|
||||||
|
ifInstalled _ alt = alt
|
||||||
|
|
||||||
|
noCheck :: Monad m => a () -> m (MaybeExe (a ()))
|
||||||
|
noCheck = return . flip Installed []
|
||||||
|
|
||||||
|
-- not sure what to do with these
|
||||||
|
|
||||||
|
soundDir :: FilePath
|
||||||
|
soundDir = "sound"
|
||||||
|
|
||||||
|
spawnSound :: MonadIO m => FilePath -> m () -> m () -> IO (MaybeExe (m ()))
|
||||||
|
spawnSound file pre post = runIfInstalled [exe "paplay"]
|
||||||
|
$ pre >> playSound file >> post
|
||||||
|
|
||||||
|
playSound :: MonadIO m => FilePath -> m ()
|
||||||
|
playSound file = do
|
||||||
|
path <- (</> soundDir </> file) <$> getXMonadDir
|
||||||
|
-- paplay seems to have less latency than aplay
|
||||||
|
spawnCmd "paplay" [path]
|
|
@ -2,25 +2,8 @@
|
||||||
-- | Functions for formatting and spawning shell commands
|
-- | Functions for formatting and spawning shell commands
|
||||||
|
|
||||||
module XMonad.Internal.Shell
|
module XMonad.Internal.Shell
|
||||||
( MaybeExe(..)
|
( fmtCmd
|
||||||
, UnitType(..)
|
|
||||||
, Dependency(..)
|
|
||||||
, MaybeX
|
|
||||||
, exe
|
|
||||||
, systemUnit
|
|
||||||
, userUnit
|
|
||||||
, runIfInstalled
|
|
||||||
, depInstalled
|
|
||||||
, warnMissing
|
|
||||||
, whenInstalled
|
|
||||||
, ifInstalled
|
|
||||||
, spawnIfInstalled
|
|
||||||
, spawnCmdIfInstalled
|
|
||||||
, noCheck
|
|
||||||
, fmtCmd
|
|
||||||
, spawnCmd
|
, spawnCmd
|
||||||
, spawnSound
|
|
||||||
, playSound
|
|
||||||
, doubleQuote
|
, doubleQuote
|
||||||
, singleQuote
|
, singleQuote
|
||||||
, skip
|
, skip
|
||||||
|
@ -30,137 +13,16 @@ module XMonad.Internal.Shell
|
||||||
, (#!>>)
|
, (#!>>)
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad (filterM)
|
|
||||||
import Control.Monad.IO.Class
|
import Control.Monad.IO.Class
|
||||||
|
|
||||||
import Data.Maybe (isJust)
|
|
||||||
|
|
||||||
import System.Directory (findExecutable)
|
|
||||||
import System.Exit
|
|
||||||
import System.FilePath.Posix
|
|
||||||
|
|
||||||
import XMonad.Core (X, getXMonadDir)
|
|
||||||
import XMonad.Internal.Process
|
import XMonad.Internal.Process
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
|
||||||
-- | 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
|
|
||||||
|
|
||||||
instance Functor MaybeExe where
|
|
||||||
fmap f (Installed x ds) = Installed (f x) ds
|
|
||||||
fmap _ (Missing x) = Missing x
|
|
||||||
fmap _ Ignore = Ignore
|
|
||||||
|
|
||||||
type MaybeX = MaybeExe (X ())
|
|
||||||
|
|
||||||
warnMissing :: Dependency -> IO ()
|
|
||||||
warnMissing Dependency {depRequired = r, depName = n, depType = t } =
|
|
||||||
putStrLn $ "WARNING: " ++ r' ++ " " ++ fmtType t ++ " not found: " ++ n
|
|
||||||
where
|
|
||||||
fmtType Executable = "executable"
|
|
||||||
fmtType (Systemd u) =
|
|
||||||
"systemd " ++ (if u == UserUnit then "user" else "system") ++ " unit"
|
|
||||||
r' = if r then "required" else "optional"
|
|
||||||
|
|
||||||
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
|
|
||||||
|
|
||||||
spawnIfInstalled :: MonadIO m => String -> IO (MaybeExe (m ()))
|
|
||||||
spawnIfInstalled n = runIfInstalled [exe n] $ spawn n
|
|
||||||
|
|
||||||
spawnCmdIfInstalled :: MonadIO m => String -> [String] -> IO (MaybeExe (m ()))
|
|
||||||
spawnCmdIfInstalled n args = runIfInstalled [exe n] $ spawnCmd n args
|
|
||||||
|
|
||||||
whenInstalled :: Monad m => MaybeExe (m ()) -> m ()
|
|
||||||
whenInstalled = flip ifInstalled skip
|
|
||||||
|
|
||||||
ifInstalled :: MaybeExe a -> a -> a
|
|
||||||
ifInstalled (Installed x _) _ = x
|
|
||||||
ifInstalled _ alt = alt
|
|
||||||
|
|
||||||
skip :: Monad m => m ()
|
|
||||||
skip = return ()
|
|
||||||
|
|
||||||
noCheck :: Monad m => a () -> m (MaybeExe (a ()))
|
|
||||||
noCheck = return . flip Installed []
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Opening subshell
|
-- | Opening subshell
|
||||||
|
|
||||||
spawnCmd :: MonadIO m => String -> [String] -> m ()
|
spawnCmd :: MonadIO m => String -> [String] -> m ()
|
||||||
spawnCmd cmd args = spawn $ fmtCmd cmd args
|
spawnCmd cmd args = spawn $ fmtCmd cmd args
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
|
||||||
-- | Playing sound
|
|
||||||
|
|
||||||
soundDir :: FilePath
|
|
||||||
soundDir = "sound"
|
|
||||||
|
|
||||||
spawnSound :: MonadIO m => FilePath -> m () -> m () -> IO (MaybeExe (m ()))
|
|
||||||
spawnSound file pre post = runIfInstalled [exe "paplay"]
|
|
||||||
$ pre >> playSound file >> post
|
|
||||||
|
|
||||||
playSound :: MonadIO m => FilePath -> m ()
|
|
||||||
playSound file = do
|
|
||||||
path <- (</> soundDir </> file) <$> getXMonadDir
|
|
||||||
-- paplay seems to have less latency than aplay
|
|
||||||
spawnCmd "paplay" [path]
|
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Formatting commands
|
-- | Formatting commands
|
||||||
|
|
||||||
|
@ -192,3 +54,6 @@ doubleQuote s = "\"" ++ s ++ "\""
|
||||||
|
|
||||||
singleQuote :: String -> String
|
singleQuote :: String -> String
|
||||||
singleQuote s = "'" ++ s ++ "'"
|
singleQuote s = "'" ++ s ++ "'"
|
||||||
|
|
||||||
|
skip :: Monad m => m ()
|
||||||
|
skip = return ()
|
||||||
|
|
|
@ -16,7 +16,7 @@ import Control.Monad
|
||||||
|
|
||||||
import Xmobar
|
import Xmobar
|
||||||
|
|
||||||
import XMonad.Internal.DBus.IntelBacklight
|
import XMonad.Internal.DBus.Brightness.IntelBacklight
|
||||||
|
|
||||||
newtype IntelBacklight = IntelBacklight String deriving (Read, Show)
|
newtype IntelBacklight = IntelBacklight String deriving (Read, Show)
|
||||||
|
|
||||||
|
@ -26,8 +26,8 @@ blAlias = "intelbacklight"
|
||||||
instance Exec IntelBacklight where
|
instance Exec IntelBacklight where
|
||||||
alias (IntelBacklight _) = blAlias
|
alias (IntelBacklight _) = blAlias
|
||||||
start (IntelBacklight icon) cb = do
|
start (IntelBacklight icon) cb = do
|
||||||
_ <- matchSignal $ cb . formatBrightness
|
_ <- matchSignalIB $ cb . formatBrightness
|
||||||
cb . formatBrightness =<< callGetBrightness
|
cb . formatBrightness =<< callGetBrightnessIB
|
||||||
forever (threadDelay 5000000)
|
forever (threadDelay 5000000)
|
||||||
where
|
where
|
||||||
formatBrightness = \case
|
formatBrightness = \case
|
||||||
|
|
|
@ -12,12 +12,14 @@ library
|
||||||
, XMonad.Internal.Theme
|
, XMonad.Internal.Theme
|
||||||
, XMonad.Internal.Notify
|
, XMonad.Internal.Notify
|
||||||
, XMonad.Internal.Shell
|
, XMonad.Internal.Shell
|
||||||
|
, XMonad.Internal.Dependency
|
||||||
, XMonad.Internal.IO
|
, XMonad.Internal.IO
|
||||||
, XMonad.Internal.Command.Desktop
|
, XMonad.Internal.Command.Desktop
|
||||||
, XMonad.Internal.Command.DMenu
|
, XMonad.Internal.Command.DMenu
|
||||||
, XMonad.Internal.Command.Power
|
, XMonad.Internal.Command.Power
|
||||||
, XMonad.Internal.DBus.Common
|
, XMonad.Internal.DBus.Common
|
||||||
, XMonad.Internal.DBus.IntelBacklight
|
, XMonad.Internal.DBus.Brightness.IntelBacklight
|
||||||
|
, XMonad.Internal.DBus.Brightness.Common
|
||||||
, XMonad.Internal.DBus.Control
|
, XMonad.Internal.DBus.Control
|
||||||
, XMonad.Internal.DBus.Screensaver
|
, XMonad.Internal.DBus.Screensaver
|
||||||
, XMonad.Internal.Process
|
, XMonad.Internal.Process
|
||||||
|
|
Loading…
Reference in New Issue