From db7011bfd81b9dafb96ee3f8ec8d8594c8638739 Mon Sep 17 00:00:00 2001 From: ndwarshuis Date: Mon, 2 Jan 2023 19:15:25 -0500 Subject: [PATCH] ENH generalize brightness exporters --- .../Internal/DBus/Brightness/ClevoKeyboard.hs | 22 ++++---- lib/XMonad/Internal/DBus/Brightness/Common.hs | 50 +++++++++---------- .../DBus/Brightness/IntelBacklight.hs | 20 +++++--- 3 files changed, 48 insertions(+), 44 deletions(-) diff --git a/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs b/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs index 3564773..7495da2 100644 --- a/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs +++ b/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs @@ -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) diff --git a/lib/XMonad/Internal/DBus/Brightness/Common.hs b/lib/XMonad/Internal/DBus/Brightness/Common.hs index cbf0ca5..4ef5e9d 100644 --- a/lib/XMonad/Internal/DBus/Brightness/Common.hs +++ b/lib/XMonad/Internal/DBus/Brightness/Common.hs @@ -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 ()) diff --git a/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs b/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs index 6e90376..b4ea2ec 100644 --- a/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs +++ b/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs @@ -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)