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