141 lines
3.6 KiB
Haskell
141 lines
3.6 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- DBus module for Clevo Keyboard control
|
|
|
|
module XMonad.Internal.DBus.Brightness.ClevoKeyboard
|
|
( callGetBrightnessCK
|
|
, matchSignalCK
|
|
, exportClevoKeyboard
|
|
, clevoKeyboardControls
|
|
, clevoKeyboardSignalDep
|
|
, blPath
|
|
)
|
|
where
|
|
|
|
import DBus
|
|
import Data.Internal.DBus
|
|
import Data.Internal.XIO
|
|
import RIO
|
|
import RIO.FilePath
|
|
import XMonad.Internal.DBus.Brightness.Common
|
|
import XMonad.Internal.IO
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- Low level sysfs functions
|
|
|
|
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"
|
|
|
|
stateChange :: Bool -> IO ()
|
|
stateChange = writeBool stateFile
|
|
|
|
stateOn :: IO ()
|
|
stateOn = stateChange True
|
|
|
|
stateOff :: IO ()
|
|
stateOff = stateChange False
|
|
|
|
brightnessFile :: FilePath
|
|
brightnessFile = backlightDir </> "brightness"
|
|
|
|
getBrightness :: RawBounds -> IO Brightness
|
|
getBrightness bounds = readPercent bounds brightnessFile
|
|
|
|
minBrightness :: RawBounds -> IO Brightness
|
|
minBrightness bounds = do
|
|
b <- writePercentMin bounds brightnessFile
|
|
stateOff
|
|
return b
|
|
|
|
maxBrightness :: RawBounds -> IO Brightness
|
|
maxBrightness bounds = stateOn >> writePercentMax bounds brightnessFile
|
|
|
|
incBrightness :: RawBounds -> IO Brightness
|
|
incBrightness bounds = stateOn >> incPercent steps brightnessFile bounds
|
|
|
|
decBrightness :: RawBounds -> IO Brightness
|
|
decBrightness bounds = do
|
|
b <- decPercent steps brightnessFile bounds
|
|
when (b == 0) stateOff
|
|
return b
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- DBus interface
|
|
|
|
blPath :: ObjectPath
|
|
blPath = objectPath_ "/clevo_keyboard"
|
|
|
|
interface :: InterfaceName
|
|
interface = interfaceName_ "org.xmonad.Brightness"
|
|
|
|
clevoKeyboardConfig :: BrightnessConfig RawBrightness Brightness
|
|
clevoKeyboardConfig =
|
|
BrightnessConfig
|
|
{ bcMin = minBrightness
|
|
, bcMax = maxBrightness
|
|
, bcInc = incBrightness
|
|
, bcDec = decBrightness
|
|
, bcGet = getBrightness
|
|
, bcGetMax = return maxRawBrightness
|
|
, bcMinRaw = minRawBrightness
|
|
, bcPath = blPath
|
|
, bcInterface = interface
|
|
, bcName = "Clevo keyboard"
|
|
}
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- Exported haskell API
|
|
|
|
stateFileDep :: IODependency_
|
|
stateFileDep = pathRW stateFile [Package AUR "tuxedo-keyboard"]
|
|
|
|
brightnessFileDep :: IODependency_
|
|
brightnessFileDep = pathR brightnessFile [Package AUR "tuxedo-keyboard"]
|
|
|
|
clevoKeyboardSignalDep :: DBusDependency_ SesClient
|
|
clevoKeyboardSignalDep = signalDep clevoKeyboardConfig
|
|
|
|
exportClevoKeyboard
|
|
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
|
=> Maybe SesClient
|
|
-> Sometimes (m (), m ())
|
|
exportClevoKeyboard =
|
|
brightnessExporter
|
|
xpfClevoBacklight
|
|
[]
|
|
[stateFileDep, brightnessFileDep]
|
|
clevoKeyboardConfig
|
|
|
|
clevoKeyboardControls :: MonadUnliftIO m => Maybe SesClient -> BrightnessControls m
|
|
clevoKeyboardControls = brightnessControls xpfClevoBacklight clevoKeyboardConfig
|
|
|
|
callGetBrightnessCK :: MonadUnliftIO m => SesClient -> m (Maybe Brightness)
|
|
callGetBrightnessCK = callGetBrightness clevoKeyboardConfig
|
|
|
|
matchSignalCK
|
|
:: MonadUnliftIO m
|
|
=> (Maybe Brightness -> m ())
|
|
-> SesClient
|
|
-> m ()
|
|
matchSignalCK = matchSignal clevoKeyboardConfig
|