From 53279475f46a8f8e696aa6979dc5b49acb235221 Mon Sep 17 00:00:00 2001 From: ndwarshuis Date: Sat, 6 Nov 2021 10:59:45 -0400 Subject: [PATCH] REF move intel backlight IO crap into separate module --- lib/XMonad/Internal/DBus/IntelBacklight.hs | 116 +++++++------------- lib/XMonad/Internal/IO.hs | 122 +++++++++++++++++++++ lib/Xmobar/Plugins/IntelBacklight.hs | 2 +- my-xmonad.cabal | 1 + 4 files changed, 161 insertions(+), 80 deletions(-) create mode 100644 lib/XMonad/Internal/IO.hs diff --git a/lib/XMonad/Internal/DBus/IntelBacklight.hs b/lib/XMonad/Internal/DBus/IntelBacklight.hs index f0f4020..db8cced 100644 --- a/lib/XMonad/Internal/DBus/IntelBacklight.hs +++ b/lib/XMonad/Internal/DBus/IntelBacklight.hs @@ -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 diff --git a/lib/XMonad/Internal/IO.hs b/lib/XMonad/Internal/IO.hs new file mode 100644 index 0000000..fed5f6e --- /dev/null +++ b/lib/XMonad/Internal/IO.hs @@ -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 diff --git a/lib/Xmobar/Plugins/IntelBacklight.hs b/lib/Xmobar/Plugins/IntelBacklight.hs index ec42358..3176686 100644 --- a/lib/Xmobar/Plugins/IntelBacklight.hs +++ b/lib/Xmobar/Plugins/IntelBacklight.hs @@ -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" diff --git a/my-xmonad.cabal b/my-xmonad.cabal index 1d82876..20b10f8 100644 --- a/my-xmonad.cabal +++ b/my-xmonad.cabal @@ -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