Compare commits
No commits in common. "db7011bfd81b9dafb96ee3f8ec8d8594c8638739" and "524818decf0b54d954f47110dee90e68bfb7db17" have entirely different histories.
db7011bfd8
...
524818decf
|
@ -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
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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 ())
|
||||||
|
|
|
@ -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)
|
||||||
|
|
Loading…
Reference in New Issue