ndwarshuis
/
xmonad-config
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

REF move intel backlight IO crap into separate module

This commit is contained in:
Nathan Dwarshuis 2021-11-06 10:59:45 -04:00
parent 3ca6bc222d
commit 53279475f4
4 changed files with 161 additions and 80 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

116
lib/XMonad/Internal/DBus/IntelBacklight.hs
View File

@ -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,29 +154,29 @@ data BacklightControls = BacklightControls
exportIntelBacklight :: Client -> IO (Maybe BacklightControls)
exportIntelBacklight client = do
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
maxval <- getMaxRawBrightness -- assume the max value will never change
let stepsize = maxBrightness / steps
let emit' = emitBrightness client
let emit' f = emitBrightness client =<< f maxval
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 memMaxBrightness $ emit' maxBrightness
, autoMethod memMinBrightness $ emit' minBrightness
, autoMethod memIncBrightness $ emit' incBrightness
, autoMethod memDecBrightness $ emit' decBrightness
, autoMethod memGetBrightness (round <$> getBrightness maxval :: IO Int32)
]
}
return $ BacklightControls
{ backlightMax = callMaxBrightness
, backlightMin = callMinBrightness
, backlightUp = callIncBrightness
, backlightDown = callDecBrightness
}
emitBrightness :: Client -> Brightness -> IO ()
emitBrightness client cur = emit client

122
lib/XMonad/Internal/IO.hs Normal file
View File

@ -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

2
lib/Xmobar/Plugins/IntelBacklight.hs
View File

@ -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"

1
my-xmonad.cabal
View File

@ -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