Compare commits

..

No commits in common. "db7011bfd81b9dafb96ee3f8ec8d8594c8638739" and "524818decf0b54d954f47110dee90e68bfb7db17" have entirely different histories.

4 changed files with 49 additions and 52 deletions

View File

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

View File

@ -46,34 +46,34 @@ backlightDir = "/sys/devices/platform/tuxedo_keyboard"
stateFile :: FilePath stateFile :: FilePath
stateFile = backlightDir </> "state" stateFile = backlightDir </> "state"
stateChange :: MonadUnliftIO m => Bool -> m () stateChange :: Bool -> IO ()
stateChange = writeBool stateFile stateChange = writeBool stateFile
stateOn :: MonadUnliftIO m => m () stateOn :: IO ()
stateOn = stateChange True stateOn = stateChange True
stateOff :: MonadUnliftIO m => m () stateOff :: IO ()
stateOff = stateChange False stateOff = stateChange False
brightnessFile :: FilePath brightnessFile :: FilePath
brightnessFile = backlightDir </> "brightness" brightnessFile = backlightDir </> "brightness"
getBrightness :: MonadUnliftIO m => RawBounds -> m Brightness getBrightness :: RawBounds -> IO Brightness
getBrightness bounds = readPercent bounds brightnessFile getBrightness bounds = readPercent bounds brightnessFile
minBrightness :: MonadUnliftIO m => RawBounds -> m Brightness minBrightness :: RawBounds -> IO Brightness
minBrightness bounds = do minBrightness bounds = do
b <- writePercentMin bounds brightnessFile b <- writePercentMin bounds brightnessFile
stateOff stateOff
return b return b
maxBrightness :: MonadUnliftIO m => RawBounds -> m Brightness maxBrightness :: RawBounds -> IO Brightness
maxBrightness bounds = stateOn >> writePercentMax bounds brightnessFile maxBrightness bounds = stateOn >> writePercentMax bounds brightnessFile
incBrightness :: MonadUnliftIO m => RawBounds -> m Brightness incBrightness :: RawBounds -> IO Brightness
incBrightness bounds = stateOn >> incPercent steps brightnessFile bounds incBrightness bounds = stateOn >> incPercent steps brightnessFile bounds
decBrightness :: MonadUnliftIO m => RawBounds -> m Brightness decBrightness :: RawBounds -> IO Brightness
decBrightness bounds = do decBrightness bounds = do
b <- decPercent steps brightnessFile bounds b <- decPercent steps brightnessFile bounds
when (b == 0) stateOff when (b == 0) stateOff
@ -88,7 +88,7 @@ blPath = objectPath_ "/clevo_keyboard"
interface :: InterfaceName interface :: InterfaceName
interface = interfaceName_ "org.xmonad.Brightness" interface = interfaceName_ "org.xmonad.Brightness"
clevoKeyboardConfig :: MonadUnliftIO m => BrightnessConfig m RawBrightness Brightness clevoKeyboardConfig :: BrightnessConfig RawBrightness Brightness
clevoKeyboardConfig = clevoKeyboardConfig =
BrightnessConfig BrightnessConfig
{ bcMin = minBrightness { bcMin = minBrightness
@ -113,9 +113,7 @@ brightnessFileDep :: IODependency_
brightnessFileDep = pathR brightnessFile [Package AUR "tuxedo-keyboard"] brightnessFileDep = pathR brightnessFile [Package AUR "tuxedo-keyboard"]
clevoKeyboardSignalDep :: DBusDependency_ SesClient clevoKeyboardSignalDep :: DBusDependency_ SesClient
clevoKeyboardSignalDep = clevoKeyboardSignalDep = signalDep clevoKeyboardConfig
-- TODO do I need to get rid of the IO here?
signalDep (clevoKeyboardConfig :: BrightnessConfig IO RawBrightness Brightness)
exportClevoKeyboard exportClevoKeyboard
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m) :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)

View File

@ -1,5 +1,4 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- DBus module for DBus brightness controls -- DBus module for DBus brightness controls
@ -33,14 +32,14 @@ import XMonad.Internal.DBus.Common
-- integer and emit a signal with the same brightness value. Additionally, there -- integer and emit a signal with the same brightness value. Additionally, there
-- is one method to get the current brightness. -- is one method to get the current brightness.
data BrightnessConfig m a b = BrightnessConfig data BrightnessConfig a b = BrightnessConfig
{ bcMin :: (a, a) -> m b { bcMin :: (a, a) -> IO b
, bcMax :: (a, a) -> m b , bcMax :: (a, a) -> IO b
, bcDec :: (a, a) -> m b , bcDec :: (a, a) -> IO b
, bcInc :: (a, a) -> m b , bcInc :: (a, a) -> IO b
, bcGet :: (a, a) -> m b , bcGet :: (a, a) -> IO b
, bcMinRaw :: a , bcMinRaw :: a
, bcGetMax :: m a , bcGetMax :: IO a
, bcPath :: ObjectPath , bcPath :: ObjectPath
, bcInterface :: InterfaceName , bcInterface :: InterfaceName
, bcName :: T.Text , bcName :: T.Text
@ -56,7 +55,7 @@ data BrightnessControls m = BrightnessControls
brightnessControls brightnessControls
:: MonadUnliftIO m :: MonadUnliftIO m
=> XPQuery => XPQuery
-> BrightnessConfig m a b -> BrightnessConfig a b
-> Maybe SesClient -> Maybe SesClient
-> BrightnessControls m -> BrightnessControls m
brightnessControls q bc cl = brightnessControls q bc cl =
@ -71,20 +70,20 @@ brightnessControls q bc cl =
callGetBrightness callGetBrightness
:: (MonadUnliftIO m, SafeClient c, Num n) :: (MonadUnliftIO m, SafeClient c, Num n)
=> BrightnessConfig m a b => BrightnessConfig a b
-> c -> c
-> m (Maybe n) -> m (Maybe n)
callGetBrightness BrightnessConfig {bcPath = p, bcInterface = i} client = callGetBrightness BrightnessConfig {bcPath = p, bcInterface = i} client =
either (const Nothing) bodyGetBrightness either (const Nothing) bodyGetBrightness
<$> callMethod client xmonadBusName p i memGet <$> callMethod client xmonadBusName p i memGet
signalDep :: BrightnessConfig m a b -> DBusDependency_ SesClient signalDep :: BrightnessConfig a b -> DBusDependency_ SesClient
signalDep BrightnessConfig {bcPath = p, bcInterface = i} = signalDep BrightnessConfig {bcPath = p, bcInterface = i} =
Endpoint [] xmonadBusName p i $ Signal_ memCur Endpoint [] xmonadBusName p i $ Signal_ memCur
matchSignal matchSignal
:: (MonadUnliftIO m, SafeClient c, Num n) :: (MonadUnliftIO m, SafeClient c, Num n)
=> BrightnessConfig m a b => BrightnessConfig a b
-> (Maybe n -> m ()) -> (Maybe n -> m ())
-> c -> c
-> m () -> m ()
@ -107,7 +106,7 @@ brightnessExporter
=> XPQuery => XPQuery
-> [Fulfillment] -> [Fulfillment]
-> [IODependency_] -> [IODependency_]
-> BrightnessConfig m a b -> BrightnessConfig a b
-> Maybe SesClient -> Maybe SesClient
-> Sometimes (m (), m ()) -> Sometimes (m (), m ())
brightnessExporter q ful deps bc@BrightnessConfig {bcName = n} cl = brightnessExporter q ful deps bc@BrightnessConfig {bcName = n} cl =
@ -118,19 +117,21 @@ brightnessExporter q ful deps bc@BrightnessConfig {bcName = n} cl =
exportBrightnessControlsInner exportBrightnessControlsInner
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, RealFrac b) :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, RealFrac b)
=> BrightnessConfig m a b => BrightnessConfig a b
-> SesClient -> SesClient
-> (m (), m ()) -> (m (), m ())
exportBrightnessControlsInner bc = cmd exportBrightnessControlsInner bc = cmd
where where
cmd = exportPair (bcPath bc) $ \cl_ -> do cmd = exportPair (bcPath bc) $ \cl_ -> do
-- assume the max value will never change -- up = liftIO $ do
bounds <- (bcMinRaw bc,) <$> bcGetMax bc -- let ses = toClient cl
runIO <- askRunInIO maxval <- liftIO $ bcGetMax bc -- assume the max value will never change
let autoMethod' m f = autoMethod m $ runIO $ do let bounds = (bcMinRaw bc, maxval)
val <- f bc bounds let autoMethod' m f = autoMethod m $ emitBrightness bc cl_ =<< f bc bounds
emitBrightness bc cl_ val let funget = bcGet bc
funget <- toIO $ bcGet bc bounds -- export
-- ses
-- (bcPath bc)
return $ return $
defaultInterface defaultInterface
{ interfaceName = bcInterface bc { interfaceName = bcInterface bc
@ -139,10 +140,11 @@ exportBrightnessControlsInner bc = cmd
, autoMethod' memMin bcMin , autoMethod' memMin bcMin
, autoMethod' memInc bcInc , autoMethod' memInc bcInc
, autoMethod' memDec bcDec , autoMethod' memDec bcDec
, autoMethod memGet (round <$> funget :: IO Int32) , autoMethod memGet (round <$> funget bounds :: IO Int32)
] ]
, interfaceSignals = [sig] , interfaceSignals = [sig]
} }
-- down = liftIO $ unexport (toClient cl) (bcPath bc)
sig = sig =
I.Signal I.Signal
{ I.signalName = memCur { I.signalName = memCur
@ -156,7 +158,7 @@ exportBrightnessControlsInner bc = cmd
emitBrightness emitBrightness
:: (MonadUnliftIO m, RealFrac b) :: (MonadUnliftIO m, RealFrac b)
=> BrightnessConfig m a b => BrightnessConfig a b
-> Client -> Client
-> b -> b
-> m () -> m ()
@ -169,7 +171,7 @@ callBacklight
:: MonadUnliftIO m :: MonadUnliftIO m
=> XPQuery => XPQuery
-> Maybe SesClient -> Maybe SesClient
-> BrightnessConfig m a b -> BrightnessConfig a b
-> T.Text -> T.Text
-> MemberName -> MemberName
-> Sometimes (m ()) -> Sometimes (m ())

View File

@ -45,22 +45,22 @@ maxFile = backlightDir </> "max_brightness"
curFile :: FilePath curFile :: FilePath
curFile = backlightDir </> "brightness" curFile = backlightDir </> "brightness"
getMaxRawBrightness :: MonadUnliftIO m => m RawBrightness getMaxRawBrightness :: IO RawBrightness
getMaxRawBrightness = readInt maxFile getMaxRawBrightness = readInt maxFile
getBrightness :: MonadUnliftIO m => RawBounds -> m Brightness getBrightness :: RawBounds -> IO Brightness
getBrightness bounds = readPercent bounds curFile getBrightness bounds = readPercent bounds curFile
minBrightness :: MonadUnliftIO m => RawBounds -> m Brightness minBrightness :: RawBounds -> IO Brightness
minBrightness bounds = writePercentMin bounds curFile minBrightness bounds = writePercentMin bounds curFile
maxBrightness :: MonadUnliftIO m => RawBounds -> m Brightness maxBrightness :: RawBounds -> IO Brightness
maxBrightness bounds = writePercentMax bounds curFile maxBrightness bounds = writePercentMax bounds curFile
incBrightness :: MonadUnliftIO m => RawBounds -> m Brightness incBrightness :: RawBounds -> IO Brightness
incBrightness = incPercent steps curFile incBrightness = incPercent steps curFile
decBrightness :: MonadUnliftIO m => RawBounds -> m Brightness decBrightness :: RawBounds -> IO Brightness
decBrightness = decPercent steps curFile decBrightness = decPercent steps curFile
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -72,9 +72,7 @@ blPath = objectPath_ "/intelbacklight"
interface :: InterfaceName interface :: InterfaceName
interface = interfaceName_ "org.xmonad.Brightness" interface = interfaceName_ "org.xmonad.Brightness"
intelBacklightConfig intelBacklightConfig :: BrightnessConfig RawBrightness Brightness
:: MonadUnliftIO m
=> BrightnessConfig m RawBrightness Brightness
intelBacklightConfig = intelBacklightConfig =
BrightnessConfig BrightnessConfig
{ bcMin = minBrightness { bcMin = minBrightness
@ -99,9 +97,7 @@ maxFileDep :: IODependency_
maxFileDep = pathR maxFile [] maxFileDep = pathR maxFile []
intelBacklightSignalDep :: DBusDependency_ SesClient intelBacklightSignalDep :: DBusDependency_ SesClient
intelBacklightSignalDep = intelBacklightSignalDep = signalDep intelBacklightConfig
-- TODO do I need to get rid of the IO here?
signalDep (intelBacklightConfig :: BrightnessConfig IO RawBrightness Brightness)
exportIntelBacklight exportIntelBacklight
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m) :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)