WIP add backlight to dbus

bin/xmobar.hs

@@ -1,3 +1,4 @@
+-- import Xmobar.Backlight
 import Xmobar.Screensaver
 
 import qualified Theme as T
@@ -25,6 +26,7 @@ myTemplate = formatTemplate left right
             , "%alsa:default:Master%"
             , "%battery%"
             , "%bright%"
+            -- , "%betterbacklight%"
             , "%screensaver%"
             , "%locks%"
             , "%date%"
@@ -52,8 +54,8 @@ blockFont = T.fmtFontXFT T.font
   }
 
 config :: String -> Config
-config confDir = defaultConfig { 
-  font = barFont
+config confDir = defaultConfig
+  { font = barFont
   , additionalFonts = [ iconFont, blockFont ]
   , textOffset = 16
   , textOffsets = [ 16, 17 ]
@@ -103,6 +105,8 @@ config confDir = defaultConfig {
                        , "-D", "intel_backlight"
                        ] 10
 
+      -- , Run $ Backlight ("", "")
+
       , Run $ Wireless "wlp0s20f3"
         [ "-t", "<qualityipat><essid>"
         , "--"

bin/xmonad.hs

@@ -7,6 +7,10 @@ import ACPI
 import SendXMsg
 import Notify
 import Shell
+import DBus.Client (Client)
+
+import DBus.Common
+import DBus.Backlight
 
 import qualified Theme as T
 
@@ -75,11 +79,12 @@ import XMonad.Util.Run
 import qualified XMonad.StackSet as W
 
 main = do
+  dbClient <- startXMonadService
   (barPID, h) <- spawnPipe' "xmobar"
   pwrPID <- spawnPID "powermon"
   launch
     $ ewmh
-    $ addDescrKeys' ((myModMask, xK_F1), showKeybindings) (myKeys [pwrPID, barPID])
+    $ addDescrKeys' ((myModMask, xK_F1), showKeybindings) (myKeys [pwrPID, barPID] dbClient)
     $ def { terminal = myTerm
           , modMask = myModMask
           , layoutHook = myLayouts
@@ -436,8 +441,10 @@ runVBox = spawnCmdOwnWS "vbox-start win8raw" [] myVMWorkspace
 runGimp :: X ()
 runGimp = spawnCmdOwnWS "gimp" [] myGimpWorkspace
 
-runCleanup :: [ProcessID] -> X ()
-runCleanup ps = io $ mapM_ killPID ps
+runCleanup :: [ProcessID] -> Client -> X ()
+runCleanup ps client = io $ do
+  mapM_ killPID ps
+  stopXMonadService client
 
 killPID :: ProcessID -> IO ()
 killPID pID = do
@@ -509,10 +516,10 @@ runDecBacklight :: X ()
 runDecBacklight = spawnCmd "adj_backlight" ["down"]
 
 runMinBacklight :: X ()
-runMinBacklight = spawnCmd "adj_backlight" ["min"]
+runMinBacklight = io callMinBrightness
 
 runMaxBacklight :: X ()
-runMaxBacklight = spawnCmd "adj_backlight" ["max"]
+runMaxBacklight = io callMaxBrightness
 
 showWorkspace tag = windows $ W.view tag
 
@@ -557,8 +564,8 @@ mkNamedSubmap c sectionName bindings =
 
 -- NOTE: the following bindings are used by dunst:
 -- "M-~", "M-<esc>", "M-S-<esc>", "M-S-."
-myKeys :: [ProcessID] -> XConfig Layout -> [((KeyMask, KeySym), NamedAction)]
-myKeys hs c =
+myKeys :: [ProcessID] -> Client -> XConfig Layout -> [((KeyMask, KeySym), NamedAction)]
+myKeys hs client c =
   mkNamedSubmap c "Window Layouts"
   [ ("M-j", addName "focus down" $ windows W.focusDown)
   , ("M-k", addName "focus up" $ windows W.focusUp)
@@ -640,7 +647,7 @@ myKeys hs c =
   , ("M-M1-.", addName "backlight max" runMaxBacklight)
   , ("M-M1-=", addName "enable screensaver" enableDPMS)
   , ("M-M1--", addName "disable screensaver" disableDPMS)
-  , ("M-<F2>", addName "restart xmonad" $ runCleanup hs >> runRestart)
+  , ("M-<F2>", addName "restart xmonad" $ runCleanup hs client >> runRestart)
   , ("M-S-<F2>", addName "recompile xmonad" runRecompile)
   , ("M-<End>", addName "power menu" myPowerPrompt)
   , ("M-<Home>", addName "quit xmonad" myQuitPrompt)

lib/DBus/Backlight.hs

@@ -0,0 +1,111 @@
+{-# 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)] }

lib/DBus/Common.hs

@@ -0,0 +1,39 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module DBus.Common where
+
+-- import Control.Concurrent
+-- import Control.Monad
+
+import DBus.Backlight
+
+-- import DBus
+import DBus.Client
+
+onFoo :: IO String
+onFoo = return "testicle"
+
+startXMonadService :: IO Client
+startXMonadService = do
+  client <- connectSession
+  requestResult <- requestName client "org.xmonad" []
+  -- TODO if the client is not released on shutdown the owner will be
+  -- different
+  if requestResult /= NamePrimaryOwner then
+    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 ]
+      }
+  return client
+
+stopXMonadService :: Client -> IO ()
+stopXMonadService client = do
+  reply <- releaseName client "org.xmonad"
+  disconnect client
+  print reply
+  return ()
+

lib/Xmobar/Backlight.hs

@@ -0,0 +1,34 @@
+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"

my-xmonad.cabal

@@ -10,13 +10,18 @@ library
                    , Theme
                    , Notify
                    , Shell
+                   , DBus.Common
+                   , DBus.Backlight
                    , Xmobar.Screensaver
+                   , Xmobar.Backlight
     build-depends: base
                  , X11 >= 1.9.1
                  , colour >= 2.3.5
                  , xmonad >= 0.13
                  , xmonad-contrib >= 0.13
                  , fdo-notify
+                 , dbus >= 1.2.7
+                 , text >= 1.2.3.1
                  , xmobar
     ghc-options: -Wall -Werror -fno-warn-missing-signatures
     default-language: Haskell2010
@@ -32,6 +37,7 @@ executable xmonad
                  , process >= 1.6.5.0
                  , directory >= 1.3.3.0
                  , containers >= 0.6.0.1
+                 , dbus >= 1.2.7
                  , my-xmonad
     default-language: Haskell2010
     ghc-options: -Wall -Werror -fno-warn-missing-signatures -threaded
@@ -40,6 +46,7 @@ executable xmobar
     main-is: bin/xmobar.hs
     build-depends: base
                  , xmonad >= 0.13
+                 , dbus >= 1.2.7
                  , xmobar
                  , my-xmonad
     default-language: Haskell2010