xmonad-config/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs

149 lines
4.0 KiB
Haskell
Raw Permalink Normal View History

2021-11-21 00:42:40 -05:00
--------------------------------------------------------------------------------
2022-12-30 14:58:23 -05:00
-- DBus module for Clevo Keyboard control
2021-11-21 00:42:40 -05:00
module XMonad.Internal.DBus.Brightness.ClevoKeyboard
( callGetBrightnessCK
, matchSignalCK
, exportClevoKeyboard
, clevoKeyboardControls
, clevoKeyboardSignalDep
, blPath
2022-12-30 14:58:23 -05:00
)
where
import DBus
import Data.Internal.DBus
2023-01-01 18:33:02 -05:00
import Data.Internal.XIO
2022-12-31 15:26:22 -05:00
import RIO
2022-12-30 14:58:23 -05:00
import RIO.FilePath
import XMonad.Internal.DBus.Brightness.Common
import XMonad.Internal.IO
2021-11-21 00:42:40 -05:00
--------------------------------------------------------------------------------
2022-12-30 14:58:23 -05:00
-- Low level sysfs functions
2021-11-21 00:42:40 -05:00
type Brightness = Float
type RawBrightness = Int32
type RawBounds = (RawBrightness, RawBrightness)
steps :: Int
steps = 16
-- assume this is hardcoded into the driver and will never change
maxRawBrightness :: RawBrightness
maxRawBrightness = 255
minRawBrightness :: RawBrightness
minRawBrightness = 0
backlightDir :: FilePath
backlightDir = "/sys/devices/platform/tuxedo_keyboard"
stateFile :: FilePath
stateFile = backlightDir </> "state"
2023-01-02 19:15:25 -05:00
stateChange :: MonadUnliftIO m => Bool -> m ()
2021-11-21 00:42:40 -05:00
stateChange = writeBool stateFile
2023-01-02 19:15:25 -05:00
stateOn :: MonadUnliftIO m => m ()
2021-11-21 00:42:40 -05:00
stateOn = stateChange True
2023-01-02 19:15:25 -05:00
stateOff :: MonadUnliftIO m => m ()
2021-11-21 00:42:40 -05:00
stateOff = stateChange False
brightnessFile :: FilePath
brightnessFile = backlightDir </> "brightness"
2023-01-02 19:15:25 -05:00
getBrightness :: MonadUnliftIO m => RawBounds -> m Brightness
2021-11-21 00:42:40 -05:00
getBrightness bounds = readPercent bounds brightnessFile
2023-01-02 19:15:25 -05:00
minBrightness :: MonadUnliftIO m => RawBounds -> m Brightness
2021-11-21 00:42:40 -05:00
minBrightness bounds = do
b <- writePercentMin bounds brightnessFile
stateOff
return b
2023-01-02 19:15:25 -05:00
maxBrightness :: MonadUnliftIO m => RawBounds -> m Brightness
2021-11-21 00:42:40 -05:00
maxBrightness bounds = stateOn >> writePercentMax bounds brightnessFile
2023-01-02 19:15:25 -05:00
incBrightness :: MonadUnliftIO m => RawBounds -> m Brightness
2021-11-21 00:42:40 -05:00
incBrightness bounds = stateOn >> incPercent steps brightnessFile bounds
2023-01-02 19:15:25 -05:00
decBrightness :: MonadUnliftIO m => RawBounds -> m Brightness
2021-11-21 00:42:40 -05:00
decBrightness bounds = do
b <- decPercent steps brightnessFile bounds
when (b == 0) stateOff
return b
--------------------------------------------------------------------------------
2022-12-30 14:58:23 -05:00
-- DBus interface
2021-11-21 00:42:40 -05:00
blPath :: ObjectPath
blPath = objectPath_ "/clevo_keyboard"
interface :: InterfaceName
interface = interfaceName_ "org.xmonad.Brightness"
2023-01-02 19:15:25 -05:00
clevoKeyboardConfig :: MonadUnliftIO m => BrightnessConfig m RawBrightness Brightness
2022-12-30 14:58:23 -05:00
clevoKeyboardConfig =
BrightnessConfig
{ bcMin = minBrightness
, bcMax = maxBrightness
, bcInc = incBrightness
, bcDec = decBrightness
, bcGet = getBrightness
, bcGetMax = return maxRawBrightness
, bcMinRaw = minRawBrightness
, bcPath = blPath
, bcInterface = interface
, bcName = "Clevo keyboard"
}
2021-11-21 00:42:40 -05:00
--------------------------------------------------------------------------------
2022-12-30 14:58:23 -05:00
-- Exported haskell API
2021-11-21 00:42:40 -05:00
stateFileDep :: IODependency_
stateFileDep = pathRW stateFile [Package AUR "tuxedo-keyboard"]
2021-11-21 00:42:40 -05:00
brightnessFileDep :: IODependency_
brightnessFileDep = pathR brightnessFile [Package AUR "tuxedo-keyboard"]
2021-11-21 00:42:40 -05:00
2022-07-09 17:08:10 -04:00
clevoKeyboardSignalDep :: DBusDependency_ SesClient
2023-01-02 19:15:25 -05:00
clevoKeyboardSignalDep =
-- TODO do I need to get rid of the IO here?
signalDep (clevoKeyboardConfig :: BrightnessConfig IO RawBrightness Brightness)
2021-11-21 00:42:40 -05:00
exportClevoKeyboard
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
2023-10-27 23:12:22 -04:00
=> Maybe NamedSesConnection
-> Sometimes (m (), m ())
2022-12-30 14:58:23 -05:00
exportClevoKeyboard =
brightnessExporter
xpfClevoBacklight
[]
[stateFileDep, brightnessFileDep]
clevoKeyboardConfig
2021-11-21 00:42:40 -05:00
2023-01-03 22:18:55 -05:00
clevoKeyboardControls
:: (HasClient (DBusEnv env), MonadReader env m, MonadUnliftIO m)
2023-10-27 23:12:22 -04:00
=> Maybe NamedSesConnection
2023-01-03 22:18:55 -05:00
-> BrightnessControls m
clevoKeyboardControls = brightnessControls xpfClevoBacklight clevoKeyboardConfig
2021-11-21 00:42:40 -05:00
2023-01-03 22:18:55 -05:00
callGetBrightnessCK
:: (SafeClient c, HasClient env, MonadReader (env c) m, MonadUnliftIO m)
=> m (Maybe Brightness)
2022-07-09 17:44:14 -04:00
callGetBrightnessCK = callGetBrightness clevoKeyboardConfig
2021-11-21 00:42:40 -05:00
2022-12-31 15:26:22 -05:00
matchSignalCK
2023-01-03 22:18:55 -05:00
:: ( SafeClient c
, HasClient env
, MonadReader (env c) m
, MonadUnliftIO m
)
2022-12-31 15:26:22 -05:00
=> (Maybe Brightness -> m ())
-> m ()
2022-07-09 17:44:14 -04:00
matchSignalCK = matchSignal clevoKeyboardConfig