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
|
||||
|
||||
module XMonad.Internal.DBus.IntelBacklight
|
||||
( callDecBrightness
|
||||
, callGetBrightness
|
||||
, callIncBrightness
|
||||
, callMaxBrightness
|
||||
, callMinBrightness
|
||||
( callGetBrightness
|
||||
, exportIntelBacklight
|
||||
, matchSignal
|
||||
, hasBacklight
|
||||
|
|
@ -16,40 +12,25 @@ module XMonad.Internal.DBus.IntelBacklight
|
|||
|
||||
import Control.Monad (void)
|
||||
|
||||
import Data.Char
|
||||
import Data.Either
|
||||
import Data.Int (Int32)
|
||||
import Data.Text (pack, unpack)
|
||||
import Data.Text.IO as T (readFile, writeFile)
|
||||
|
||||
import DBus
|
||||
import DBus.Client
|
||||
|
||||
import System.Directory
|
||||
import System.FilePath.Posix
|
||||
import System.IO.Error
|
||||
|
||||
import XMonad.Internal.DBus.Common
|
||||
import XMonad.Internal.IO
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | 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 RawBrightness = Int32
|
||||
|
||||
maxBrightness :: Brightness
|
||||
maxBrightness = 10000
|
||||
|
||||
steps :: Brightness
|
||||
steps :: Int
|
||||
steps = 16
|
||||
|
||||
backlightDir :: FilePath
|
||||
|
|
@ -61,42 +42,23 @@ maxFile = backlightDir </> "max_brightness"
|
|||
curFile :: FilePath
|
||||
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 = readFileInt 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
|
||||
getMaxRawBrightness = readInt maxFile
|
||||
|
||||
getBrightness :: RawBrightness -> IO Brightness
|
||||
getBrightness maxRaw = rawToNorm maxRaw <$> getRawBrightness
|
||||
getBrightness upper = readPercent upper curFile
|
||||
|
||||
changeBrightness :: RawBrightness -> Brightness -> IO Brightness
|
||||
changeBrightness maxRaw delta = setBrightness maxRaw
|
||||
. (+ delta) =<< getBrightness maxRaw
|
||||
minBrightness :: RawBrightness -> IO Brightness
|
||||
minBrightness upper = writePercentMin upper curFile
|
||||
|
||||
setBrightness :: RawBrightness -> Brightness -> IO Brightness
|
||||
setBrightness maxRaw newNorm = do
|
||||
let newNorm' = truncateNorm newNorm
|
||||
setRawBrightness $ normToRaw maxRaw newNorm'
|
||||
return newNorm'
|
||||
maxBrightness :: RawBrightness -> IO Brightness
|
||||
maxBrightness upper = writePercentMax upper curFile
|
||||
|
||||
incBrightness :: RawBrightness -> IO Brightness
|
||||
incBrightness = incPercent steps curFile
|
||||
|
||||
decBrightness :: RawBrightness -> IO Brightness
|
||||
decBrightness = decPercent steps curFile
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Access checks
|
||||
|
|
@ -107,17 +69,13 @@ setBrightness maxRaw newNorm = do
|
|||
-- Left x -> backlight present but could not access (x explaining why)
|
||||
hasBacklight' :: IO (Either String Bool)
|
||||
hasBacklight' = do
|
||||
mx <- doesFileExist maxFile
|
||||
cx <- doesFileExist curFile
|
||||
if not $ mx || cx
|
||||
then return $ Right False
|
||||
else do
|
||||
mp <- tryIOError $ readable <$> getPermissions maxFile
|
||||
cp <- tryIOError $ (\p -> writable p && readable p) <$> getPermissions curFile
|
||||
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"
|
||||
mx <- isReadable maxFile
|
||||
cx <- isWritable curFile
|
||||
return $ case (mx, cx) of
|
||||
(NotFoundError, NotFoundError) -> Right False
|
||||
(PermResult True, PermResult True) -> Right True
|
||||
(PermResult _, PermResult _) -> Left "Insufficient permissions for backlight files"
|
||||
_ -> Left "Could not determine permissions for backlight files"
|
||||
|
||||
msg :: Either String Bool -> IO ()
|
||||
msg (Right True) = return ()
|
||||
|
|
@ -180,7 +138,7 @@ callBacklight :: MemberName -> IO ()
|
|||
callBacklight method = void $ callMethod $ methodCall blPath interface method
|
||||
|
||||
bodyGetBrightness :: [Variant] -> Maybe Brightness
|
||||
bodyGetBrightness [b] = toFloat <$> (fromVariant b :: Maybe Int32)
|
||||
bodyGetBrightness [b] = fromIntegral <$> (fromVariant b :: Maybe Int32)
|
||||
bodyGetBrightness _ = Nothing
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
|
@ -196,30 +154,30 @@ data BacklightControls = BacklightControls
|
|||
exportIntelBacklight :: Client -> IO (Maybe BacklightControls)
|
||||
exportIntelBacklight client = do
|
||||
b <- hasBacklightMsg
|
||||
if b then Just <$> exportIntelBacklight' client else return Nothing
|
||||
|
||||
exportIntelBacklight' :: Client -> IO BacklightControls
|
||||
exportIntelBacklight' client = do
|
||||
maxval <- getMaxRawBrightness -- assume the max value will never change
|
||||
let stepsize = maxBrightness / steps
|
||||
let emit' = emitBrightness client
|
||||
export client blPath defaultInterface
|
||||
{ interfaceName = interface
|
||||
, interfaceMethods =
|
||||
[ autoMethod memMaxBrightness $ emit' =<< setBrightness maxval maxBrightness
|
||||
, autoMethod memMinBrightness $ emit' =<< setBrightness maxval 0
|
||||
, autoMethod memIncBrightness $ emit' =<< changeBrightness maxval stepsize
|
||||
, autoMethod memDecBrightness $ emit' =<< changeBrightness maxval (-stepsize)
|
||||
, autoMethod memGetBrightness (round <$> getBrightness maxval :: IO Int32)
|
||||
]
|
||||
}
|
||||
return $ BacklightControls
|
||||
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 ()
|
||||
exportIntelBacklight' client = do
|
||||
maxval <- getMaxRawBrightness -- assume the max value will never change
|
||||
let emit' f = emitBrightness client =<< f maxval
|
||||
export client blPath defaultInterface
|
||||
{ interfaceName = interface
|
||||
, interfaceMethods =
|
||||
[ autoMethod memMaxBrightness $ emit' maxBrightness
|
||||
, autoMethod memMinBrightness $ emit' minBrightness
|
||||
, autoMethod memIncBrightness $ emit' incBrightness
|
||||
, autoMethod memDecBrightness $ emit' decBrightness
|
||||
, autoMethod memGetBrightness (round <$> getBrightness maxval :: IO Int32)
|
||||
]
|
||||
}
|
||||
|
||||
emitBrightness :: Client -> Brightness -> IO ()
|
||||
emitBrightness client cur = emit client
|
||||
$ brSignal { signalBody = [toVariant (round cur :: Int32)] }
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
where
|
||||
formatBrightness = \case
|
||||
Just b -> icon ++ show (round $ b / 100 :: Integer) ++ "%"
|
||||
Just b -> icon ++ show (round b :: Integer) ++ "%"
|
||||
Nothing -> "N/A"
|
||||
|
|
|
|||
|
|
@ -12,6 +12,7 @@ library
|
|||
, XMonad.Internal.Theme
|
||||
, XMonad.Internal.Notify
|
||||
, XMonad.Internal.Shell
|
||||
, XMonad.Internal.IO
|
||||
, XMonad.Internal.Command.Desktop
|
||||
, XMonad.Internal.Command.DMenu
|
||||
, XMonad.Internal.Command.Power
|
||||
|
|
|
|||
Loading…
Reference in New Issue