REF move intel backlight IO crap into separate module
This commit is contained in:
parent
3ca6bc222d
commit
53279475f4
|
@ -2,11 +2,7 @@
|
||||||
-- | DBus module for Intel Backlight control
|
-- | DBus module for Intel Backlight control
|
||||||
|
|
||||||
module XMonad.Internal.DBus.IntelBacklight
|
module XMonad.Internal.DBus.IntelBacklight
|
||||||
( callDecBrightness
|
( callGetBrightness
|
||||||
, callGetBrightness
|
|
||||||
, callIncBrightness
|
|
||||||
, callMaxBrightness
|
|
||||||
, callMinBrightness
|
|
||||||
, exportIntelBacklight
|
, exportIntelBacklight
|
||||||
, matchSignal
|
, matchSignal
|
||||||
, hasBacklight
|
, hasBacklight
|
||||||
|
@ -16,40 +12,25 @@ module XMonad.Internal.DBus.IntelBacklight
|
||||||
|
|
||||||
import Control.Monad (void)
|
import Control.Monad (void)
|
||||||
|
|
||||||
import Data.Char
|
|
||||||
import Data.Either
|
import Data.Either
|
||||||
import Data.Int (Int32)
|
import Data.Int (Int32)
|
||||||
import Data.Text (pack, unpack)
|
|
||||||
import Data.Text.IO as T (readFile, writeFile)
|
|
||||||
|
|
||||||
import DBus
|
import DBus
|
||||||
import DBus.Client
|
import DBus.Client
|
||||||
|
|
||||||
import System.Directory
|
|
||||||
import System.FilePath.Posix
|
import System.FilePath.Posix
|
||||||
import System.IO.Error
|
|
||||||
|
|
||||||
import XMonad.Internal.DBus.Common
|
import XMonad.Internal.DBus.Common
|
||||||
|
import XMonad.Internal.IO
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Low level sysfs functions
|
-- | Low level sysfs functions
|
||||||
--
|
--
|
||||||
-- Distinguish between "raw" brightness "normalized" brightness with two type
|
|
||||||
-- synonyms. The former is the value read directly in sysfs and generally goes
|
|
||||||
-- from 1 (min brightness) to some multiple 1000's number (note that raw values
|
|
||||||
-- of 0 turn the monitor off). The latter is the raw brightness scaled from 0 to
|
|
||||||
-- 10000 (which can easily be converted to a percent).
|
|
||||||
|
|
||||||
-- use strict IO here, the data in these files is literally 1-10 bytes
|
|
||||||
|
|
||||||
type Brightness = Float
|
type Brightness = Float
|
||||||
|
|
||||||
type RawBrightness = Int32
|
type RawBrightness = Int32
|
||||||
|
|
||||||
maxBrightness :: Brightness
|
steps :: Int
|
||||||
maxBrightness = 10000
|
|
||||||
|
|
||||||
steps :: Brightness
|
|
||||||
steps = 16
|
steps = 16
|
||||||
|
|
||||||
backlightDir :: FilePath
|
backlightDir :: FilePath
|
||||||
|
@ -61,42 +42,23 @@ maxFile = backlightDir </> "max_brightness"
|
||||||
curFile :: FilePath
|
curFile :: FilePath
|
||||||
curFile = backlightDir </> "brightness"
|
curFile = backlightDir </> "brightness"
|
||||||
|
|
||||||
toFloat :: Integral a => a -> Float
|
|
||||||
toFloat = fromIntegral
|
|
||||||
|
|
||||||
readFileInt :: FilePath -> IO RawBrightness
|
|
||||||
readFileInt file = read . takeWhile isDigit . unpack <$> T.readFile file
|
|
||||||
|
|
||||||
getMaxRawBrightness :: IO RawBrightness
|
getMaxRawBrightness :: IO RawBrightness
|
||||||
getMaxRawBrightness = readFileInt maxFile
|
getMaxRawBrightness = readInt maxFile
|
||||||
|
|
||||||
getRawBrightness :: IO RawBrightness
|
|
||||||
getRawBrightness = readFileInt curFile
|
|
||||||
|
|
||||||
setRawBrightness :: RawBrightness -> IO ()
|
|
||||||
setRawBrightness = T.writeFile curFile . pack . show
|
|
||||||
|
|
||||||
rawToNorm :: RawBrightness -> RawBrightness -> Brightness
|
|
||||||
rawToNorm maxb cur = maxBrightness * (toFloat cur - 1) / (toFloat maxb - 1)
|
|
||||||
|
|
||||||
normToRaw :: RawBrightness -> Brightness -> RawBrightness
|
|
||||||
normToRaw maxb cur = round $ 1 + cur / maxBrightness * (toFloat maxb - 1)
|
|
||||||
|
|
||||||
truncateNorm :: Brightness -> Brightness
|
|
||||||
truncateNorm = min maxBrightness . max 0
|
|
||||||
|
|
||||||
getBrightness :: RawBrightness -> IO Brightness
|
getBrightness :: RawBrightness -> IO Brightness
|
||||||
getBrightness maxRaw = rawToNorm maxRaw <$> getRawBrightness
|
getBrightness upper = readPercent upper curFile
|
||||||
|
|
||||||
changeBrightness :: RawBrightness -> Brightness -> IO Brightness
|
minBrightness :: RawBrightness -> IO Brightness
|
||||||
changeBrightness maxRaw delta = setBrightness maxRaw
|
minBrightness upper = writePercentMin upper curFile
|
||||||
. (+ delta) =<< getBrightness maxRaw
|
|
||||||
|
|
||||||
setBrightness :: RawBrightness -> Brightness -> IO Brightness
|
maxBrightness :: RawBrightness -> IO Brightness
|
||||||
setBrightness maxRaw newNorm = do
|
maxBrightness upper = writePercentMax upper curFile
|
||||||
let newNorm' = truncateNorm newNorm
|
|
||||||
setRawBrightness $ normToRaw maxRaw newNorm'
|
incBrightness :: RawBrightness -> IO Brightness
|
||||||
return newNorm'
|
incBrightness = incPercent steps curFile
|
||||||
|
|
||||||
|
decBrightness :: RawBrightness -> IO Brightness
|
||||||
|
decBrightness = decPercent steps curFile
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Access checks
|
-- | Access checks
|
||||||
|
@ -107,17 +69,13 @@ setBrightness maxRaw newNorm = do
|
||||||
-- Left x -> backlight present but could not access (x explaining why)
|
-- Left x -> backlight present but could not access (x explaining why)
|
||||||
hasBacklight' :: IO (Either String Bool)
|
hasBacklight' :: IO (Either String Bool)
|
||||||
hasBacklight' = do
|
hasBacklight' = do
|
||||||
mx <- doesFileExist maxFile
|
mx <- isReadable maxFile
|
||||||
cx <- doesFileExist curFile
|
cx <- isWritable curFile
|
||||||
if not $ mx || cx
|
return $ case (mx, cx) of
|
||||||
then return $ Right False
|
(NotFoundError, NotFoundError) -> Right False
|
||||||
else do
|
(PermResult True, PermResult True) -> Right True
|
||||||
mp <- tryIOError $ readable <$> getPermissions maxFile
|
(PermResult _, PermResult _) -> Left "Insufficient permissions for backlight files"
|
||||||
cp <- tryIOError $ (\p -> writable p && readable p) <$> getPermissions curFile
|
_ -> Left "Could not determine permissions for backlight files"
|
||||||
return $ case (mp, cp) of
|
|
||||||
(Right True, Right True) -> Right True
|
|
||||||
(Right _, Right _) -> Left "Insufficient permissions for backlight files"
|
|
||||||
_ -> Left "Could not determine backlight file permissions"
|
|
||||||
|
|
||||||
msg :: Either String Bool -> IO ()
|
msg :: Either String Bool -> IO ()
|
||||||
msg (Right True) = return ()
|
msg (Right True) = return ()
|
||||||
|
@ -180,7 +138,7 @@ callBacklight :: MemberName -> IO ()
|
||||||
callBacklight method = void $ callMethod $ methodCall blPath interface method
|
callBacklight method = void $ callMethod $ methodCall blPath interface method
|
||||||
|
|
||||||
bodyGetBrightness :: [Variant] -> Maybe Brightness
|
bodyGetBrightness :: [Variant] -> Maybe Brightness
|
||||||
bodyGetBrightness [b] = toFloat <$> (fromVariant b :: Maybe Int32)
|
bodyGetBrightness [b] = fromIntegral <$> (fromVariant b :: Maybe Int32)
|
||||||
bodyGetBrightness _ = Nothing
|
bodyGetBrightness _ = Nothing
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
|
@ -196,29 +154,29 @@ data BacklightControls = BacklightControls
|
||||||
exportIntelBacklight :: Client -> IO (Maybe BacklightControls)
|
exportIntelBacklight :: Client -> IO (Maybe BacklightControls)
|
||||||
exportIntelBacklight client = do
|
exportIntelBacklight client = do
|
||||||
b <- hasBacklightMsg
|
b <- hasBacklightMsg
|
||||||
if b then Just <$> exportIntelBacklight' client else return Nothing
|
if b then exportIntelBacklight' client >> return (Just bc) else return Nothing
|
||||||
|
where
|
||||||
|
bc = BacklightControls
|
||||||
|
{ backlightMax = callMaxBrightness
|
||||||
|
, backlightMin = callMinBrightness
|
||||||
|
, backlightUp = callIncBrightness
|
||||||
|
, backlightDown = callDecBrightness
|
||||||
|
}
|
||||||
|
|
||||||
exportIntelBacklight' :: Client -> IO BacklightControls
|
exportIntelBacklight' :: Client -> IO ()
|
||||||
exportIntelBacklight' client = do
|
exportIntelBacklight' client = do
|
||||||
maxval <- getMaxRawBrightness -- assume the max value will never change
|
maxval <- getMaxRawBrightness -- assume the max value will never change
|
||||||
let stepsize = maxBrightness / steps
|
let emit' f = emitBrightness client =<< f maxval
|
||||||
let emit' = emitBrightness client
|
|
||||||
export client blPath defaultInterface
|
export client blPath defaultInterface
|
||||||
{ interfaceName = interface
|
{ interfaceName = interface
|
||||||
, interfaceMethods =
|
, interfaceMethods =
|
||||||
[ autoMethod memMaxBrightness $ emit' =<< setBrightness maxval maxBrightness
|
[ autoMethod memMaxBrightness $ emit' maxBrightness
|
||||||
, autoMethod memMinBrightness $ emit' =<< setBrightness maxval 0
|
, autoMethod memMinBrightness $ emit' minBrightness
|
||||||
, autoMethod memIncBrightness $ emit' =<< changeBrightness maxval stepsize
|
, autoMethod memIncBrightness $ emit' incBrightness
|
||||||
, autoMethod memDecBrightness $ emit' =<< changeBrightness maxval (-stepsize)
|
, autoMethod memDecBrightness $ emit' decBrightness
|
||||||
, autoMethod memGetBrightness (round <$> getBrightness maxval :: IO Int32)
|
, autoMethod memGetBrightness (round <$> getBrightness maxval :: IO Int32)
|
||||||
]
|
]
|
||||||
}
|
}
|
||||||
return $ BacklightControls
|
|
||||||
{ backlightMax = callMaxBrightness
|
|
||||||
, backlightMin = callMinBrightness
|
|
||||||
, backlightUp = callIncBrightness
|
|
||||||
, backlightDown = callDecBrightness
|
|
||||||
}
|
|
||||||
|
|
||||||
emitBrightness :: Client -> Brightness -> IO ()
|
emitBrightness :: Client -> Brightness -> IO ()
|
||||||
emitBrightness client cur = emit client
|
emitBrightness client cur = emit client
|
||||||
|
|
|
@ -0,0 +1,122 @@
|
||||||
|
{-# LANGUAGE ViewPatterns #-}
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | Random IO-ish functions used throughtout xmonad
|
||||||
|
--
|
||||||
|
-- Most (probably all) of these functions are intended to work with sysfs where
|
||||||
|
-- some safe assumptions can be made about file contents.
|
||||||
|
|
||||||
|
module XMonad.Internal.IO
|
||||||
|
( readInt
|
||||||
|
, readBool
|
||||||
|
, readPercent
|
||||||
|
, writeInt
|
||||||
|
, writeBool
|
||||||
|
, writePercent
|
||||||
|
, writePercentMin
|
||||||
|
, writePercentMax
|
||||||
|
, decPercent
|
||||||
|
, incPercent
|
||||||
|
, isReadable
|
||||||
|
, isWritable
|
||||||
|
, PermResult(..)
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Data.Char
|
||||||
|
import Data.Text (pack, unpack)
|
||||||
|
import Data.Text.IO as T (readFile, writeFile)
|
||||||
|
|
||||||
|
import System.Directory
|
||||||
|
import System.IO.Error
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | read
|
||||||
|
|
||||||
|
readInt :: (Read a, Integral a) => FilePath -> IO a
|
||||||
|
readInt = fmap (read . takeWhile isDigit . unpack) . T.readFile
|
||||||
|
|
||||||
|
readBool :: FilePath -> IO Bool
|
||||||
|
readBool = fmap (==(1 :: Int)) . readInt
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | write
|
||||||
|
|
||||||
|
writeInt :: (Show a, Integral a) => FilePath -> a -> IO ()
|
||||||
|
writeInt f = T.writeFile f . pack . show
|
||||||
|
|
||||||
|
writeBool :: FilePath -> Bool -> IO ()
|
||||||
|
writeBool f b = writeInt f ((if b then 1 else 0) :: Int)
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | percent-based read/write
|
||||||
|
--
|
||||||
|
-- "Raw" values are whatever is stored in sysfs and "percent" is the user-facing
|
||||||
|
-- value. Assume that the file being read has a min of 0 and an unchanging max
|
||||||
|
-- given by a runtime argument, which is scaled linearly to the range 0-100
|
||||||
|
-- (percent).
|
||||||
|
|
||||||
|
rawToPercent :: (Integral a, Integral b, Read b, RealFrac c) => a -> b -> c
|
||||||
|
rawToPercent upper raw = 100 * (fromIntegral raw - 1) / (fromIntegral upper - 1)
|
||||||
|
|
||||||
|
readPercent :: (Integral a, RealFrac b) => a -> FilePath -> IO b
|
||||||
|
readPercent upper path = do
|
||||||
|
i <- readInt path
|
||||||
|
return $ rawToPercent upper (i :: Integer)
|
||||||
|
|
||||||
|
percentToRaw :: (Integral a, RealFrac b, Integral c) => a -> b -> c
|
||||||
|
percentToRaw upper perc = round $ 1 + perc / 100.0 * (fromIntegral upper - 1)
|
||||||
|
|
||||||
|
writePercent :: (Integral a, RealFrac b) => a -> FilePath -> b -> IO b
|
||||||
|
writePercent upper path perc = do
|
||||||
|
let t | perc > 100 = 100
|
||||||
|
| perc < 0 = 0
|
||||||
|
| otherwise = perc
|
||||||
|
writeInt path (percentToRaw upper t :: Int)
|
||||||
|
return t
|
||||||
|
|
||||||
|
writePercentMin :: (Integral a, RealFrac b) => a -> FilePath -> IO b
|
||||||
|
writePercentMin upper path = writePercent upper path 0
|
||||||
|
|
||||||
|
writePercentMax :: (Integral a, RealFrac b) => a -> FilePath -> IO b
|
||||||
|
writePercentMax upper path = writePercent upper path 100
|
||||||
|
|
||||||
|
shiftPercent :: (Integral a, RealFrac b) => (b -> b -> b) -> Int -> FilePath
|
||||||
|
-> a -> IO b
|
||||||
|
shiftPercent f steps path upper = writePercent upper path . f stepsize
|
||||||
|
=<< readPercent upper path
|
||||||
|
where
|
||||||
|
stepsize = 100 / fromIntegral steps
|
||||||
|
|
||||||
|
incPercent :: (Integral a, RealFrac b) => Int -> FilePath -> a -> IO b
|
||||||
|
incPercent = shiftPercent (+)
|
||||||
|
|
||||||
|
decPercent :: (Integral a, RealFrac b) => Int -> FilePath -> a -> IO b
|
||||||
|
decPercent = shiftPercent subtract -- silly (-) operator thingy error
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | permission query
|
||||||
|
|
||||||
|
data PermResult a = PermResult a | NotFoundError | PermError
|
||||||
|
deriving (Show, Eq)
|
||||||
|
|
||||||
|
instance Functor PermResult where
|
||||||
|
fmap f (PermResult r) = PermResult $ f r
|
||||||
|
fmap _ NotFoundError = NotFoundError
|
||||||
|
fmap _ PermError = PermError
|
||||||
|
|
||||||
|
getPermissionsSafe :: FilePath -> IO (PermResult Permissions)
|
||||||
|
getPermissionsSafe f = do
|
||||||
|
r <- tryIOError $ getPermissions f
|
||||||
|
return $ case r of
|
||||||
|
Right z -> PermResult z
|
||||||
|
Left (isPermissionError -> True) -> PermError
|
||||||
|
Left (isDoesNotExistError -> True) -> NotFoundError
|
||||||
|
-- the above error should be the only ones thrown by getPermission,
|
||||||
|
-- so the catchall case should never happen
|
||||||
|
_ -> error "Unknown permission error"
|
||||||
|
|
||||||
|
isReadable :: FilePath -> IO (PermResult Bool)
|
||||||
|
isReadable = fmap (fmap readable) . getPermissionsSafe
|
||||||
|
|
||||||
|
isWritable :: FilePath -> IO (PermResult Bool)
|
||||||
|
isWritable = fmap (fmap writable) . getPermissionsSafe
|
|
@ -31,5 +31,5 @@ instance Exec IntelBacklight where
|
||||||
forever (threadDelay 5000000)
|
forever (threadDelay 5000000)
|
||||||
where
|
where
|
||||||
formatBrightness = \case
|
formatBrightness = \case
|
||||||
Just b -> icon ++ show (round $ b / 100 :: Integer) ++ "%"
|
Just b -> icon ++ show (round b :: Integer) ++ "%"
|
||||||
Nothing -> "N/A"
|
Nothing -> "N/A"
|
||||||
|
|
|
@ -12,6 +12,7 @@ library
|
||||||
, XMonad.Internal.Theme
|
, XMonad.Internal.Theme
|
||||||
, XMonad.Internal.Notify
|
, XMonad.Internal.Notify
|
||||||
, XMonad.Internal.Shell
|
, XMonad.Internal.Shell
|
||||||
|
, XMonad.Internal.IO
|
||||||
, XMonad.Internal.Command.Desktop
|
, XMonad.Internal.Command.Desktop
|
||||||
, XMonad.Internal.Command.DMenu
|
, XMonad.Internal.Command.DMenu
|
||||||
, XMonad.Internal.Command.Power
|
, XMonad.Internal.Command.Power
|
||||||
|
|
Loading…
Reference in New Issue