xmonad-config/lib/XMonad/Internal/DBus/IntelBacklight.hs

254 lines
8.2 KiB
Haskell

--------------------------------------------------------------------------------
-- | DBus module for Intel Backlight control
module XMonad.Internal.DBus.IntelBacklight
( callDecBrightness
, callGetBrightness
, callIncBrightness
, callMaxBrightness
, callMinBrightness
, exportIntelBacklight
, matchSignal
, hasBacklight
, blPath
, BacklightControls(..)
) where
import Control.Monad (void)
import Data.Char
import Data.Either
import Data.Int (Int16, 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
--------------------------------------------------------------------------------
-- | 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
-- TODO this is hacky but not sure if there is a cleaner way to enforce type
-- checking between these without making two new types and adding Integral
-- instances to both of them
type Brightness = Int16
type RawBrightness = Int32
maxBrightness :: Brightness
maxBrightness = 10000
steps :: Brightness
steps = 16
backlightDir :: FilePath
backlightDir = "/sys/class/backlight/intel_backlight/"
maxFile :: FilePath
maxFile = backlightDir </> "max_brightness"
curFile :: FilePath
curFile = backlightDir </> "brightness"
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
-- TODO this has rounding errors that make the steps uneven
rawToNorm :: RawBrightness -> RawBrightness -> Brightness
rawToNorm maxRaw curRaw = fromIntegral
$ (curRaw - 1) * maxNorm `div` (maxRaw - 1)
where
maxNorm = fromIntegral maxBrightness :: Int32
normToRaw :: RawBrightness -> Brightness -> RawBrightness
normToRaw maxRaw curNorm = curNorm' * (maxRaw - 1) `div` maxNorm + 1
where
curNorm' = fromIntegral curNorm :: Int32
maxNorm = fromIntegral maxBrightness :: Int32
truncateNorm :: Brightness -> Brightness
truncateNorm = min maxBrightness . max 0
getBrightness :: RawBrightness -> IO Brightness
getBrightness maxRaw = rawToNorm maxRaw <$> getRawBrightness
changeBrightness :: RawBrightness -> Brightness -> IO Brightness
changeBrightness maxRaw delta = setBrightness maxRaw
. (+ delta) =<< getBrightness maxRaw
setBrightness :: RawBrightness -> Brightness -> IO Brightness
setBrightness maxRaw newNorm = do
let newNorm' = truncateNorm newNorm
setRawBrightness $ normToRaw maxRaw newNorm'
return newNorm'
--------------------------------------------------------------------------------
-- | Access checks
-- | determine if backlight is accessible/present
-- Right True -> backlight accessible and present
-- Right False -> backlight not present
-- 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"
msg :: Either String Bool -> IO ()
msg (Right True) = return ()
msg (Right False) = print ("No backlight detected. Controls disabled" :: String)
msg (Left m) = print ("WARNING: " ++ m)
hasBacklightMsg :: IO Bool
hasBacklightMsg = do
b <- hasBacklight'
msg b
return $ fromRight False b
hasBacklight :: IO Bool
hasBacklight = fromRight False <$> hasBacklight'
--------------------------------------------------------------------------------
-- | DBus interface
--
-- Define four methods to increase, decrease, maximize, or minimize the
-- brightness. These methods will all return the current brightness as a 32-bit
-- integer and emit a signal with the same brightness value. Additionally, there
-- is one method to get the current brightness.
blPath :: ObjectPath
blPath = objectPath_ "/intelbacklight"
interface :: InterfaceName
interface = interfaceName_ "org.xmonad.Brightness"
memCurrentBrightness :: MemberName
memCurrentBrightness = memberName_ "CurrentBrightness"
memGetBrightness :: MemberName
memGetBrightness = memberName_ "GetBrightness"
memMaxBrightness :: MemberName
memMaxBrightness = memberName_ "MaxBrightness"
memMinBrightness :: MemberName
memMinBrightness = memberName_ "MinBrightness"
memIncBrightness :: MemberName
memIncBrightness = memberName_ "IncBrightness"
memDecBrightness :: MemberName
memDecBrightness = memberName_ "DecBrightness"
brSignal :: Signal
brSignal = signal blPath interface memCurrentBrightness
-- { signalDestination = Just "org.xmonad" }
brMatcher :: MatchRule
brMatcher = matchAny
{ matchPath = Just blPath
, matchInterface = Just interface
, matchMember = Just memCurrentBrightness
}
callBacklight :: MemberName -> IO ()
callBacklight method = void $ callMethod $ methodCall blPath interface method
bodyGetBrightness :: [Variant] -> Maybe Brightness
bodyGetBrightness [b] = fromVariant b :: Maybe Brightness
bodyGetBrightness _ = Nothing
--------------------------------------------------------------------------------
-- | Exported haskell API
data BacklightControls = BacklightControls
{ backlightMax :: IO ()
, backlightMin :: IO ()
, backlightUp :: IO ()
, backlightDown :: IO ()
}
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 `div` 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 $ getBrightness maxval
]
}
return $ BacklightControls
{ backlightMax = callMaxBrightness
, backlightMin = callMinBrightness
, backlightUp = callIncBrightness
, backlightDown = callDecBrightness
}
emitBrightness :: Client -> Brightness -> IO ()
emitBrightness client cur = emit client $ brSignal { signalBody = [toVariant cur] }
callMaxBrightness :: IO ()
callMaxBrightness = callBacklight memMaxBrightness
callMinBrightness :: IO ()
callMinBrightness = callBacklight memMinBrightness
callIncBrightness :: IO ()
callIncBrightness = callBacklight memIncBrightness
callDecBrightness :: IO ()
callDecBrightness = callBacklight memDecBrightness
callGetBrightness :: IO (Maybe Brightness)
callGetBrightness = do
reply <- callMethod $ methodCall blPath interface memGetBrightness
return $ reply >>= bodyGetBrightness
matchSignal :: (Maybe Brightness -> IO ()) -> IO SignalHandler
matchSignal cb = do
client <- connectSession
addMatch client brMatcher $ cb . bodyGetBrightness . signalBody