diff --git a/bin/xmobar.hs b/bin/xmobar.hs index dcf05f0..22ed08d 100644 --- a/bin/xmobar.hs +++ b/bin/xmobar.hs @@ -1,12 +1,12 @@ --- import Xmobar.Backlight -import Xmobar.Screensaver +import Xmobar.Plugins.IntelBacklight +import Xmobar.Plugins.Screensaver -import qualified Theme as T +import qualified Theme as T -import Data.List +import Data.List -import Xmobar -import XMonad (getXMonadDir) +import Xmobar +import XMonad (getXMonadDir) wrapColor :: String -> String -> String wrapColor c s = "" ++ s ++ "" @@ -25,8 +25,7 @@ myTemplate = formatTemplate left right right = [ "%wlp0s20f3wi%" , "%alsa:default:Master%" , "%battery%" - , "%bright%" - -- , "%betterbacklight%" + , "%intelbacklight%" , "%screensaver%" , "%locks%" , "%date%" @@ -100,12 +99,7 @@ config confDir = defaultConfig , "-i" , "\xf1e6" ] 50 - , Run $ Brightness ["-t", "\xf185%" - , "--" - , "-D", "intel_backlight" - ] 10 - - -- , Run $ Backlight ("", "") + , Run $ IntelBacklight "\xf185" , Run $ Wireless "wlp0s20f3" [ "-t", "" diff --git a/bin/xmonad.hs b/bin/xmonad.hs index 926a31d..879802b 100644 --- a/bin/xmonad.hs +++ b/bin/xmonad.hs @@ -9,8 +9,8 @@ import Notify import SendXMsg import Shell -import DBus.Backlight import DBus.Common +import DBus.IntelBacklight import qualified Theme as T @@ -521,18 +521,17 @@ runToggleBluetooth = spawn #!>> fmtCmd "bluetoothctl" ["power", "$a", ">", "/dev/null"] #!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "bluetooth powered $a" } --- TODO write these in haskell runIncBacklight :: X () -runIncBacklight = spawnCmd "adj_backlight" ["up"] +runIncBacklight = io $ void callIncBrightness runDecBacklight :: X () -runDecBacklight = spawnCmd "adj_backlight" ["down"] +runDecBacklight = io $ void callDecBrightness runMinBacklight :: X () -runMinBacklight = io callMinBrightness +runMinBacklight = io $ void callMinBrightness runMaxBacklight :: X () -runMaxBacklight = io callMaxBrightness +runMaxBacklight = io $ void callMaxBrightness showWorkspace :: WorkspaceId -> X () showWorkspace tag = windows $ W.view tag diff --git a/lib/DBus/Backlight.hs b/lib/DBus/Backlight.hs deleted file mode 100644 index 2804b74..0000000 --- a/lib/DBus/Backlight.hs +++ /dev/null @@ -1,111 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module DBus.Backlight where - --- import Control.Monad - -import Data.Char - -import Data.Int (Int32) - --- use strict IO here, the data in these files is literally 1-10 bytes -import Data.Text (pack, unpack) -import Data.Text.IO as T (readFile, writeFile) - -import DBus -import DBus.Client - -brightnessDir :: FilePath -brightnessDir = "/sys/class/backlight/intel_backlight/" - -maxFile :: String -maxFile = brightnessDir ++ "max_brightness" - -curFile :: String -curFile = brightnessDir ++ "brightness" - -steps :: Int -steps = 15 - -readFileInt :: FilePath -> IO Int -readFileInt file = do - contents <- T.readFile file - return $ read $ takeWhile isDigit $ unpack contents - -getMaxValue :: IO Int -getMaxValue = readFileInt maxFile - -getCurValue :: IO Int -getCurValue = readFileInt curFile - -getStepSize :: IO Int -getStepSize = getMaxValue >>= (\x -> return $ x `div` steps) - -setCurValue :: Int -> IO () -setCurValue = T.writeFile curFile . pack . show - -truncateValue :: Int -> Int -> Int -truncateValue maxval = min maxval . max 1 - -changeBrightness :: Int -> Int -> IO () -changeBrightness maxval delta = getCurValue - >>= setCurValue . truncateValue maxval . (+ delta) - -setBrightness :: Int -> IO () -setBrightness = setCurValue - -exportBrightness :: Client -> IO () -exportBrightness client = do - maxval <- getMaxValue - stepsize <- getStepSize - export client "/brightness" defaultInterface - { interfaceName = "org.xmonad.Brightness" - , interfaceMethods = - [ autoMethod "MaxBrightness" (setBrightness maxval) - , autoMethod "MinBrightness" (setBrightness 1) - , autoMethod "IncBrightness" (changeBrightness maxval stepsize) - , autoMethod "DecBrightness" (changeBrightness maxval (-stepsize)) - ] - } - -brPath :: ObjectPath -brPath = "/brightness" - -brInterface :: InterfaceName -brInterface = "org.xmonad.Brightness" - -brSignal :: Signal -brSignal = (signal brPath brInterface "CurrentBrightness") - -- { signalDestination = Just "org.xmonad" } - -brMatcher :: MatchRule -brMatcher = matchAny - { - -- matchSender = Just "org.xmonad" - -- , matchDestination = Just "org.xmonad" - -- matchPath = Just brPath - -- , matchInterface = Just brInterface - matchMember = Just "CurrentBrightness" - } - -callMaxBrightness :: IO () -callMaxBrightness = do - client <- connectSession - _ <- call client (methodCall "/brightness" "org.xmonad.Brightness" "MaxBrightness") - { methodCallDestination = Just "org.xmonad" } - emit client =<< wrapSig <$> getCurValue - -- print reply - where - wrapSig i = brSignal - { signalBody = [toVariant (fromIntegral i :: Int32)] } - -callMinBrightness :: IO () -callMinBrightness = do - client <- connectSession - _ <- call client (methodCall "/brightness" "org.xmonad.Brightness" "MinBrightness") - { methodCallDestination = Just "org.xmonad" } - emit client =<< wrapSig <$> getCurValue - -- print reply - where - wrapSig i = brSignal - { signalBody = [toVariant (fromIntegral i :: Int32)] } diff --git a/lib/DBus/Common.hs b/lib/DBus/Common.hs index 7616efb..9871138 100644 --- a/lib/DBus/Common.hs +++ b/lib/DBus/Common.hs @@ -2,17 +2,10 @@ module DBus.Common where --- import Control.Concurrent --- import Control.Monad +import DBus.IntelBacklight -import DBus.Backlight - --- import DBus import DBus.Client -onFoo :: IO String -onFoo = return "testicle" - startXMonadService :: IO Client startXMonadService = do client <- connectSession @@ -23,11 +16,7 @@ startXMonadService = do putStrLn "Another service owns \"org.xmonad\"" else do putStrLn "Started xmonad dbus client" - exportBrightness client - export client "/test" defaultInterface - { interfaceName = "test.iface" - , interfaceMethods = [ autoMethod "foo" onFoo ] - } + exportIntelBacklight client return client stopXMonadService :: Client -> IO () diff --git a/lib/DBus/IntelBacklight.hs b/lib/DBus/IntelBacklight.hs new file mode 100644 index 0000000..cb6aaab --- /dev/null +++ b/lib/DBus/IntelBacklight.hs @@ -0,0 +1,198 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +{- | + DBus module for backlight control +-} + +module DBus.IntelBacklight + ( callDecBrightness + , callGetBrightness + , callIncBrightness + , callMaxBrightness + , callMinBrightness + , exportIntelBacklight + , matchSignal + ) where + +import Control.Monad (forM_) + +import Data.Char + +import Data.Int (Int16, Int32) + +-- use strict IO here, the data in these files is literally 1-10 bytes +import Data.Text (pack, unpack) +import Data.Text.IO as T (readFile, writeFile) + +import DBus +import DBus.Client + +backlightDir :: FilePath +backlightDir = "/sys/class/backlight/intel_backlight/" + +maxFile :: String +maxFile = backlightDir ++ "max_brightness" + +curFile :: String +curFile = backlightDir ++ "brightness" + +steps :: Brightness +steps = 16 + +-- 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 + +readFileInt :: FilePath -> IO RawBrightness +readFileInt file = do + contents <- T.readFile file + return $ read $ takeWhile isDigit $ unpack contents + +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 maxRaw curRaw = fromIntegral + $ (curRaw - 1) * maxNorm `div` (maxRaw - 1) + where + maxNorm = fromIntegral maxBrightness :: Int32 + +normToRaw :: RawBrightness -> Brightness -> RawBrightness +normToRaw maxRaw = normalize . fromIntegral + where + normalize c = c * (maxRaw - 1) `div` maxNorm + 1 + 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' + +exportIntelBacklight :: Client -> IO () +exportIntelBacklight client = do + maxval <- getMaxRawBrightness -- assume the max value will never change + let stepsize = maxBrightness `div` steps + export client brPath defaultInterface + { interfaceName = brInterface + , interfaceMethods = + [ autoMethod brMaxBrightness (setBrightness maxval maxBrightness) + , autoMethod brMinBrightness (setBrightness maxval 0) + , autoMethod brIncBrightness (changeBrightness maxval stepsize) + , autoMethod brDecBrightness (changeBrightness maxval (-stepsize)) + , autoMethod brGetBrightness (getBrightness maxval) + ] + } + +brPath :: ObjectPath +brPath = "/intelbacklight" + +brInterface :: InterfaceName +brInterface = "org.xmonad.Brightness" + +brCurrentBrightness :: MemberName +brCurrentBrightness = "CurrentBrightness" + +brGetBrightness :: MemberName +brGetBrightness = "GetBrightness" + +brMaxBrightness :: MemberName +brMaxBrightness = "MaxBrightness" + +brMinBrightness :: MemberName +brMinBrightness = "MinBrightness" + +brIncBrightness :: MemberName +brIncBrightness = "IncBrightness" + +brDecBrightness :: MemberName +brDecBrightness = "DecBrightness" + +brSignal :: Signal +brSignal = signal brPath brInterface brCurrentBrightness + -- { signalDestination = Just "org.xmonad" } + +brMatcher :: MatchRule +brMatcher = matchAny + { matchPath = Just brPath + , matchInterface = Just brInterface + , matchMember = Just brCurrentBrightness + } + +callBacklight :: Client -> MemberName -> IO (Maybe [Variant]) +callBacklight client method = do + -- TODO this will throw a clienterror if it cannot connect at all + reply <- call client (methodCall brPath brInterface method) + { methodCallDestination = Just "org.xmonad" } + return $ case reply of + Left _ -> Nothing + Right ret -> Just $ methodReturnBody ret + +callBacklight' :: MemberName -> IO (Maybe Brightness) +callBacklight' method = do + client <- connectSession + body <- callBacklight client method + -- TODO this is a bit convoluted...I return the body in the reply of + -- the method call and feed that to the signal and then return the + -- body (the latter is not really necessary since the only things + -- that read the backlight status either use the signal or call + -- GetBrightness directly + forM_ body $ emitBrightness client + return $ body >>= signalBrightness + +emitBrightness :: Client -> [Variant] -> IO () +emitBrightness client body = + emit client $ brSignal { signalBody = body } + +signalBrightness :: [Variant] -> Maybe Brightness +signalBrightness [b] = fromVariant b :: Maybe Brightness +signalBrightness _ = Nothing + +callMaxBrightness :: IO (Maybe Brightness) +callMaxBrightness = callBacklight' brMaxBrightness + +callMinBrightness :: IO (Maybe Brightness) +callMinBrightness = callBacklight' brMinBrightness + +callIncBrightness :: IO (Maybe Brightness) +callIncBrightness = callBacklight' brIncBrightness + +callDecBrightness :: IO (Maybe Brightness) +callDecBrightness = callBacklight' brDecBrightness + +callGetBrightness :: IO (Maybe Brightness) +callGetBrightness = do + client <- connectSession + body <- callBacklight client brGetBrightness + return $ body >>= signalBrightness + +matchSignal :: (Maybe Brightness -> IO ()) -> IO SignalHandler +matchSignal cb = do + client <- connectSession + addMatch client brMatcher $ cb . pullBrightness . signalBody + where + pullBrightness = \case + [b] -> fromVariant b :: Maybe Brightness + _ -> Nothing diff --git a/lib/Xmobar/Backlight.hs b/lib/Xmobar/Backlight.hs deleted file mode 100644 index 13e05f5..0000000 --- a/lib/Xmobar/Backlight.hs +++ /dev/null @@ -1,34 +0,0 @@ -module Xmobar.Backlight where - -import Control.Monad -import Control.Concurrent - -import Data.Int (Int32) - -import DBus -import DBus.Client - -import DBus.Backlight - -import Xmobar - -data Backlight = Backlight (String, String) - deriving (Read, Show) - -instance Exec Backlight where - alias (Backlight _) = "betterbacklight" - start (Backlight _) cb = do - -- print "connecting" - client <- connectSession - _ <- addMatch client brMatcher $ \sig -> do - cb $ formatSignal sig - -- print sig - forever (threadDelay 5000) - -formatSignal :: Signal -> String -formatSignal sig = -- show $ (map fromVariant $ signalBody sig :: [Maybe Int32]) - case signalBody sig of - [] -> "N/A" - (x:_) -> case (fromVariant x :: Maybe Int32) of - Just i -> show i - Nothing -> "n/a" diff --git a/lib/Xmobar/Plugins/IntelBacklight.hs b/lib/Xmobar/Plugins/IntelBacklight.hs new file mode 100644 index 0000000..2f696b3 --- /dev/null +++ b/lib/Xmobar/Plugins/IntelBacklight.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE LambdaCase #-} + +module Xmobar.Plugins.IntelBacklight where + +import Control.Concurrent +import Control.Monad + +import DBus.IntelBacklight + +import Xmobar + +newtype IntelBacklight = IntelBacklight String deriving (Read, Show) + +instance Exec IntelBacklight where + alias (IntelBacklight _) = "intelbacklight" + start (IntelBacklight icon) cb = do + _ <- matchSignal $ cb . formatBrightness + cb . formatBrightness =<< callGetBrightness + forever (threadDelay 5000) + where + formatBrightness = \case + Just b -> icon ++ show (b `div` 100) ++ "%" + Nothing -> "N/A" diff --git a/lib/Xmobar/Screensaver.hs b/lib/Xmobar/Plugins/Screensaver.hs similarity index 87% rename from lib/Xmobar/Screensaver.hs rename to lib/Xmobar/Plugins/Screensaver.hs index 212d4fd..4004f31 100644 --- a/lib/Xmobar/Screensaver.hs +++ b/lib/Xmobar/Plugins/Screensaver.hs @@ -1,4 +1,4 @@ -module Xmobar.Screensaver where +module Xmobar.Plugins.Screensaver where import Graphics.X11.Xlib.Display import Graphics.X11.XScreenSaver @@ -6,7 +6,7 @@ import Graphics.X11.XScreenSaver import Xmobar data Screensaver = Screensaver (String, String, String) Int - deriving (Read, Show) + deriving (Read, Show) instance Exec Screensaver where alias (Screensaver _ _) = "screensaver" @@ -23,9 +23,9 @@ run' (text, colorOn, colorOff) = do Just x -> wrapColor text $ case xssi_state x of ScreenSaverDisabled -> colorOff - _ -> colorOn + _ -> colorOn Nothing -> "N/A" where -- TODO not DRY wrapColor s c = "" ++ s ++ "" - + diff --git a/my-xmonad.cabal b/my-xmonad.cabal index 3ea6309..6b56cdc 100644 --- a/my-xmonad.cabal +++ b/my-xmonad.cabal @@ -11,9 +11,9 @@ library , Notify , Shell , DBus.Common - , DBus.Backlight - , Xmobar.Screensaver - , Xmobar.Backlight + , DBus.IntelBacklight + , Xmobar.Plugins.Screensaver + , Xmobar.Plugins.IntelBacklight build-depends: base , X11 >= 1.9.1 , colour >= 2.3.5