ENH generalize brightness exporters

lib/Data/Internal/XIO.hs

@@ -320,7 +320,6 @@ data DBusDependency_ c
   = Bus [Fulfillment] BusName
   | Endpoint [Fulfillment] BusName ObjectPath InterfaceName DBusMember
   | DBusIO IODependency_
-  deriving (Generic)
 
 -- | A dependency that only requires IO to evaluate (no payload)
 data IODependency_
@@ -335,23 +334,23 @@ data SystemDependency
   | AccessiblePath FilePath Bool Bool
   | Systemd UnitType T.Text
   | Process T.Text
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show)
 
 -- | The type of a systemd service
-data UnitType = SystemUnit | UserUnit deriving (Eq, Show, Generic)
+data UnitType = SystemUnit | UserUnit deriving (Eq, Show)
 
 -- | Wrapper type to describe and endpoint
 data DBusMember
   = Method_ MemberName
   | Signal_ MemberName
   | Property_ T.Text
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Show)
 
 -- | A means to fulfill a dependency
 -- For now this is just the name of an Arch Linux package (AUR or official)
 data Fulfillment = Package ArchPkg T.Text deriving (Eq, Show, Ord)
 
-data ArchPkg = Official | AUR | Custom deriving (Eq, Show, Generic, Ord)
+data ArchPkg = Official | AUR | Custom deriving (Eq, Show, Ord)
 
 --------------------------------------------------------------------------------
 -- Tested dependency tree

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)

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
+data BrightnessConfig m a b = BrightnessConfig
-  { bcMin :: (a, a) -> IO b
+  { bcMin :: (a, a) -> m b
-  , bcMax :: (a, a) -> IO b
+  , bcMax :: (a, a) -> m b
-  , bcDec :: (a, a) -> IO b
+  , bcDec :: (a, a) -> m b
-  , bcInc :: (a, a) -> IO b
+  , bcInc :: (a, a) -> m b
-  , bcGet :: (a, a) -> IO 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
+      -- assume the max value will never change
-      -- let ses = toClient cl
+      bounds <- (bcMinRaw bc,) <$> bcGetMax bc
-      maxval <- liftIO $ bcGetMax bc -- assume the max value will never change
+      runIO <- askRunInIO
-      let bounds = (bcMinRaw bc, maxval)
+      let autoMethod' m f = autoMethod m $ runIO $ do
-      let autoMethod' m f = autoMethod m $ emitBrightness bc cl_ =<< f bc bounds
+            val <- f bc bounds
-      let funget = bcGet bc
+            emitBrightness bc cl_ val
-      -- export
+      funget <- toIO $ bcGet bc bounds
-      --   ses
-      --   (bcPath bc)
       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 ())

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)