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

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}

--------------------------------------------------------------------------------
-- DBus module for Intel Backlight control

module XMonad.Internal.DBus.Brightness.IntelBacklight
  ( callGetBrightnessIB
  , matchSignalIB
  , exportIntelBacklight
  , intelBacklightControls
  , intelBacklightSignalDep
  , blPath
  )
where

import DBus
import Data.Internal.DBus
import Data.Internal.XIO
import RIO
import RIO.FilePath
import XMonad.Internal.DBus.Brightness.Common
import XMonad.Internal.IO

--------------------------------------------------------------------------------
-- Low level sysfs functions

type Brightness = Float

type RawBrightness = Int32

type RawBounds = (RawBrightness, RawBrightness)

steps :: Int
steps = 16

minRawBrightness :: RawBrightness
minRawBrightness = 1

backlightDir :: FilePath
backlightDir = "/sys/class/backlight/intel_backlight/"

maxFile :: FilePath
maxFile = backlightDir </> "max_brightness"

curFile :: FilePath
curFile = backlightDir </> "brightness"

getMaxRawBrightness :: MonadUnliftIO m => m RawBrightness
getMaxRawBrightness = readInt maxFile

getBrightness :: MonadUnliftIO m => RawBounds -> m Brightness
getBrightness bounds = readPercent bounds curFile

minBrightness :: MonadUnliftIO m => RawBounds -> m Brightness
minBrightness bounds = writePercentMin bounds curFile

maxBrightness :: MonadUnliftIO m => RawBounds -> m Brightness
maxBrightness bounds = writePercentMax bounds curFile

incBrightness :: MonadUnliftIO m => RawBounds -> m Brightness
incBrightness = incPercent steps curFile

decBrightness :: MonadUnliftIO m => RawBounds -> m Brightness
decBrightness = decPercent steps curFile

--------------------------------------------------------------------------------
-- DBus interface

blPath :: ObjectPath
blPath = objectPath_ "/intelbacklight"

interface :: InterfaceName
interface = interfaceName_ "org.xmonad.Brightness"

intelBacklightConfig
  :: MonadUnliftIO m
  => BrightnessConfig m RawBrightness Brightness
intelBacklightConfig =
  BrightnessConfig
    { bcMin = minBrightness
    , bcMax = maxBrightness
    , bcInc = incBrightness
    , bcDec = decBrightness
    , bcGet = getBrightness
    , bcGetMax = getMaxRawBrightness
    , bcMinRaw = minRawBrightness
    , bcPath = blPath
    , bcInterface = interface
    , bcName = "Intel backlight"
    }

--------------------------------------------------------------------------------
-- Exported haskell API

curFileDep :: IODependency_
curFileDep = pathRW curFile []

maxFileDep :: IODependency_
maxFileDep = pathR maxFile []

intelBacklightSignalDep :: DBusDependency_ SesClient
intelBacklightSignalDep =
  -- TODO do I need to get rid of the IO here?
  signalDep (intelBacklightConfig :: BrightnessConfig IO RawBrightness Brightness)

exportIntelBacklight
  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
  => Maybe SesClient
  -> Sometimes (m (), m ())
exportIntelBacklight =
  brightnessExporter
    xpfIntelBacklight
    []
    [curFileDep, maxFileDep]
    intelBacklightConfig

intelBacklightControls
  :: (HasClient (DBusEnv env), MonadReader env m, MonadUnliftIO m)
  => Maybe SesClient
  -> BrightnessControls m
intelBacklightControls = brightnessControls xpfIntelBacklight intelBacklightConfig

callGetBrightnessIB
  :: (SafeClient c, HasClient env, MonadReader (env c) m, MonadUnliftIO m)
  => m (Maybe Brightness)
callGetBrightnessIB = callGetBrightness intelBacklightConfig

matchSignalIB
  :: ( SafeClient c
     , HasLogFunc (env c)
     , HasClient env
     , MonadReader (env c) m
     , MonadUnliftIO m
     )
  => (Maybe Brightness -> m ())
  -> m ()
matchSignalIB = matchSignal intelBacklightConfig