ENH generalize brightness exporters
This commit is contained in:
parent
6c23813693
commit
db7011bfd8
|
|
@ -46,34 +46,34 @@ backlightDir = "/sys/devices/platform/tuxedo_keyboard"
|
|||
stateFile :: FilePath
|
||||
stateFile = backlightDir </> "state"
|
||||
|
||||
stateChange :: Bool -> IO ()
|
||||
stateChange :: MonadUnliftIO m => Bool -> m ()
|
||||
stateChange = writeBool stateFile
|
||||
|
||||
stateOn :: IO ()
|
||||
stateOn :: MonadUnliftIO m => m ()
|
||||
stateOn = stateChange True
|
||||
|
||||
stateOff :: IO ()
|
||||
stateOff :: MonadUnliftIO m => m ()
|
||||
stateOff = stateChange False
|
||||
|
||||
brightnessFile :: FilePath
|
||||
brightnessFile = backlightDir </> "brightness"
|
||||
|
||||
getBrightness :: RawBounds -> IO Brightness
|
||||
getBrightness :: MonadUnliftIO m => RawBounds -> m Brightness
|
||||
getBrightness bounds = readPercent bounds brightnessFile
|
||||
|
||||
minBrightness :: RawBounds -> IO Brightness
|
||||
minBrightness :: MonadUnliftIO m => RawBounds -> m Brightness
|
||||
minBrightness bounds = do
|
||||
b <- writePercentMin bounds brightnessFile
|
||||
stateOff
|
||||
return b
|
||||
|
||||
maxBrightness :: RawBounds -> IO Brightness
|
||||
maxBrightness :: MonadUnliftIO m => RawBounds -> m Brightness
|
||||
maxBrightness bounds = stateOn >> writePercentMax bounds brightnessFile
|
||||
|
||||
incBrightness :: RawBounds -> IO Brightness
|
||||
incBrightness :: MonadUnliftIO m => RawBounds -> m Brightness
|
||||
incBrightness bounds = stateOn >> incPercent steps brightnessFile bounds
|
||||
|
||||
decBrightness :: RawBounds -> IO Brightness
|
||||
decBrightness :: MonadUnliftIO m => RawBounds -> m Brightness
|
||||
decBrightness bounds = do
|
||||
b <- decPercent steps brightnessFile bounds
|
||||
when (b == 0) stateOff
|
||||
|
|
@ -88,7 +88,7 @@ blPath = objectPath_ "/clevo_keyboard"
|
|||
interface :: InterfaceName
|
||||
interface = interfaceName_ "org.xmonad.Brightness"
|
||||
|
||||
clevoKeyboardConfig :: BrightnessConfig RawBrightness Brightness
|
||||
clevoKeyboardConfig :: MonadUnliftIO m => BrightnessConfig m RawBrightness Brightness
|
||||
clevoKeyboardConfig =
|
||||
BrightnessConfig
|
||||
{ bcMin = minBrightness
|
||||
|
|
@ -113,7 +113,9 @@ brightnessFileDep :: IODependency_
|
|||
brightnessFileDep = pathR brightnessFile [Package AUR "tuxedo-keyboard"]
|
||||
|
||||
clevoKeyboardSignalDep :: DBusDependency_ SesClient
|
||||
clevoKeyboardSignalDep = signalDep clevoKeyboardConfig
|
||||
clevoKeyboardSignalDep =
|
||||
-- TODO do I need to get rid of the IO here?
|
||||
signalDep (clevoKeyboardConfig :: BrightnessConfig IO RawBrightness Brightness)
|
||||
|
||||
exportClevoKeyboard
|
||||
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- DBus module for DBus brightness controls
|
||||
|
|
@ -32,14 +33,14 @@ import XMonad.Internal.DBus.Common
|
|||
-- 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, a) -> IO b
|
||||
, bcMax :: (a, a) -> IO b
|
||||
, bcDec :: (a, a) -> IO b
|
||||
, bcInc :: (a, a) -> IO b
|
||||
, bcGet :: (a, a) -> IO b
|
||||
data BrightnessConfig m a b = BrightnessConfig
|
||||
{ bcMin :: (a, a) -> m b
|
||||
, bcMax :: (a, a) -> m b
|
||||
, bcDec :: (a, a) -> m b
|
||||
, bcInc :: (a, a) -> m b
|
||||
, bcGet :: (a, a) -> m b
|
||||
, bcMinRaw :: a
|
||||
, bcGetMax :: IO a
|
||||
, bcGetMax :: m a
|
||||
, bcPath :: ObjectPath
|
||||
, bcInterface :: InterfaceName
|
||||
, bcName :: T.Text
|
||||
|
|
@ -55,7 +56,7 @@ data BrightnessControls m = BrightnessControls
|
|||
brightnessControls
|
||||
:: MonadUnliftIO m
|
||||
=> XPQuery
|
||||
-> BrightnessConfig a b
|
||||
-> BrightnessConfig m a b
|
||||
-> Maybe SesClient
|
||||
-> BrightnessControls m
|
||||
brightnessControls q bc cl =
|
||||
|
|
@ -70,20 +71,20 @@ brightnessControls q bc cl =
|
|||
|
||||
callGetBrightness
|
||||
:: (MonadUnliftIO m, SafeClient c, Num n)
|
||||
=> BrightnessConfig a b
|
||||
=> BrightnessConfig m a b
|
||||
-> c
|
||||
-> m (Maybe n)
|
||||
callGetBrightness BrightnessConfig {bcPath = p, bcInterface = i} client =
|
||||
either (const Nothing) bodyGetBrightness
|
||||
<$> callMethod client xmonadBusName p i memGet
|
||||
|
||||
signalDep :: BrightnessConfig a b -> DBusDependency_ SesClient
|
||||
signalDep :: BrightnessConfig m a b -> DBusDependency_ SesClient
|
||||
signalDep BrightnessConfig {bcPath = p, bcInterface = i} =
|
||||
Endpoint [] xmonadBusName p i $ Signal_ memCur
|
||||
|
||||
matchSignal
|
||||
:: (MonadUnliftIO m, SafeClient c, Num n)
|
||||
=> BrightnessConfig a b
|
||||
=> BrightnessConfig m a b
|
||||
-> (Maybe n -> m ())
|
||||
-> c
|
||||
-> m ()
|
||||
|
|
@ -106,7 +107,7 @@ brightnessExporter
|
|||
=> XPQuery
|
||||
-> [Fulfillment]
|
||||
-> [IODependency_]
|
||||
-> BrightnessConfig a b
|
||||
-> BrightnessConfig m a b
|
||||
-> Maybe SesClient
|
||||
-> Sometimes (m (), m ())
|
||||
brightnessExporter q ful deps bc@BrightnessConfig {bcName = n} cl =
|
||||
|
|
@ -117,21 +118,19 @@ brightnessExporter q ful deps bc@BrightnessConfig {bcName = n} cl =
|
|||
|
||||
exportBrightnessControlsInner
|
||||
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, RealFrac b)
|
||||
=> BrightnessConfig a b
|
||||
=> BrightnessConfig m a b
|
||||
-> SesClient
|
||||
-> (m (), m ())
|
||||
exportBrightnessControlsInner bc = cmd
|
||||
where
|
||||
cmd = exportPair (bcPath bc) $ \cl_ -> do
|
||||
-- up = liftIO $ do
|
||||
-- let ses = toClient cl
|
||||
maxval <- liftIO $ bcGetMax bc -- assume the max value will never change
|
||||
let bounds = (bcMinRaw bc, maxval)
|
||||
let autoMethod' m f = autoMethod m $ emitBrightness bc cl_ =<< f bc bounds
|
||||
let funget = bcGet bc
|
||||
-- export
|
||||
-- ses
|
||||
-- (bcPath bc)
|
||||
-- assume the max value will never change
|
||||
bounds <- (bcMinRaw bc,) <$> bcGetMax bc
|
||||
runIO <- askRunInIO
|
||||
let autoMethod' m f = autoMethod m $ runIO $ do
|
||||
val <- f bc bounds
|
||||
emitBrightness bc cl_ val
|
||||
funget <- toIO $ bcGet bc bounds
|
||||
return $
|
||||
defaultInterface
|
||||
{ interfaceName = bcInterface bc
|
||||
|
|
@ -140,11 +139,10 @@ exportBrightnessControlsInner bc = cmd
|
|||
, autoMethod' memMin bcMin
|
||||
, autoMethod' memInc bcInc
|
||||
, autoMethod' memDec bcDec
|
||||
, autoMethod memGet (round <$> funget bounds :: IO Int32)
|
||||
, autoMethod memGet (round <$> funget :: IO Int32)
|
||||
]
|
||||
, interfaceSignals = [sig]
|
||||
}
|
||||
-- down = liftIO $ unexport (toClient cl) (bcPath bc)
|
||||
sig =
|
||||
I.Signal
|
||||
{ I.signalName = memCur
|
||||
|
|
@ -158,7 +156,7 @@ exportBrightnessControlsInner bc = cmd
|
|||
|
||||
emitBrightness
|
||||
:: (MonadUnliftIO m, RealFrac b)
|
||||
=> BrightnessConfig a b
|
||||
=> BrightnessConfig m a b
|
||||
-> Client
|
||||
-> b
|
||||
-> m ()
|
||||
|
|
@ -171,7 +169,7 @@ callBacklight
|
|||
:: MonadUnliftIO m
|
||||
=> XPQuery
|
||||
-> Maybe SesClient
|
||||
-> BrightnessConfig a b
|
||||
-> BrightnessConfig m a b
|
||||
-> T.Text
|
||||
-> MemberName
|
||||
-> Sometimes (m ())
|
||||
|
|
|
|||
|
|
@ -45,22 +45,22 @@ maxFile = backlightDir </> "max_brightness"
|
|||
curFile :: FilePath
|
||||
curFile = backlightDir </> "brightness"
|
||||
|
||||
getMaxRawBrightness :: IO RawBrightness
|
||||
getMaxRawBrightness :: MonadUnliftIO m => m RawBrightness
|
||||
getMaxRawBrightness = readInt maxFile
|
||||
|
||||
getBrightness :: RawBounds -> IO Brightness
|
||||
getBrightness :: MonadUnliftIO m => RawBounds -> m Brightness
|
||||
getBrightness bounds = readPercent bounds curFile
|
||||
|
||||
minBrightness :: RawBounds -> IO Brightness
|
||||
minBrightness :: MonadUnliftIO m => RawBounds -> m Brightness
|
||||
minBrightness bounds = writePercentMin bounds curFile
|
||||
|
||||
maxBrightness :: RawBounds -> IO Brightness
|
||||
maxBrightness :: MonadUnliftIO m => RawBounds -> m Brightness
|
||||
maxBrightness bounds = writePercentMax bounds curFile
|
||||
|
||||
incBrightness :: RawBounds -> IO Brightness
|
||||
incBrightness :: MonadUnliftIO m => RawBounds -> m Brightness
|
||||
incBrightness = incPercent steps curFile
|
||||
|
||||
decBrightness :: RawBounds -> IO Brightness
|
||||
decBrightness :: MonadUnliftIO m => RawBounds -> m Brightness
|
||||
decBrightness = decPercent steps curFile
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
|
@ -72,7 +72,9 @@ blPath = objectPath_ "/intelbacklight"
|
|||
interface :: InterfaceName
|
||||
interface = interfaceName_ "org.xmonad.Brightness"
|
||||
|
||||
intelBacklightConfig :: BrightnessConfig RawBrightness Brightness
|
||||
intelBacklightConfig
|
||||
:: MonadUnliftIO m
|
||||
=> BrightnessConfig m RawBrightness Brightness
|
||||
intelBacklightConfig =
|
||||
BrightnessConfig
|
||||
{ bcMin = minBrightness
|
||||
|
|
@ -97,7 +99,9 @@ maxFileDep :: IODependency_
|
|||
maxFileDep = pathR maxFile []
|
||||
|
||||
intelBacklightSignalDep :: DBusDependency_ SesClient
|
||||
intelBacklightSignalDep = signalDep intelBacklightConfig
|
||||
intelBacklightSignalDep =
|
||||
-- TODO do I need to get rid of the IO here?
|
||||
signalDep (intelBacklightConfig :: BrightnessConfig IO RawBrightness Brightness)
|
||||
|
||||
exportIntelBacklight
|
||||
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
||||
|
|
|
|||
Loading…
Reference in New Issue