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

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

--------------------------------------------------------------------------------
-- DBus module for Clevo Keyboard control

module XMonad.Internal.DBus.Brightness.ClevoKeyboard
  ( callGetBrightnessCK
  , matchSignalCK
  , exportClevoKeyboard
  , clevoKeyboardControls
  , clevoKeyboardSignalDep
  , 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

-- assume this is hardcoded into the driver and will never change
maxRawBrightness :: RawBrightness
maxRawBrightness = 255

minRawBrightness :: RawBrightness
minRawBrightness = 0

backlightDir :: FilePath
backlightDir = "/sys/devices/platform/tuxedo_keyboard"

stateFile :: FilePath
stateFile = backlightDir </> "state"

stateChange :: MonadUnliftIO m => Bool -> m ()
stateChange = writeBool stateFile

stateOn :: MonadUnliftIO m => m ()
stateOn = stateChange True

stateOff :: MonadUnliftIO m => m ()
stateOff = stateChange False

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

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

minBrightness :: MonadUnliftIO m => RawBounds -> m Brightness
minBrightness bounds = do
  b <- writePercentMin bounds brightnessFile
  stateOff
  return b

maxBrightness :: MonadUnliftIO m => RawBounds -> m Brightness
maxBrightness bounds = stateOn >> writePercentMax bounds brightnessFile

incBrightness :: MonadUnliftIO m => RawBounds -> m Brightness
incBrightness bounds = stateOn >> incPercent steps brightnessFile bounds

decBrightness :: MonadUnliftIO m => RawBounds -> m Brightness
decBrightness bounds = do
  b <- decPercent steps brightnessFile bounds
  when (b == 0) stateOff
  return b

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

blPath :: ObjectPath
blPath = objectPath_ "/clevo_keyboard"

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

clevoKeyboardConfig :: MonadUnliftIO m => BrightnessConfig m RawBrightness Brightness
clevoKeyboardConfig =
  BrightnessConfig
    { bcMin = minBrightness
    , bcMax = maxBrightness
    , bcInc = incBrightness
    , bcDec = decBrightness
    , bcGet = getBrightness
    , bcGetMax = return maxRawBrightness
    , bcMinRaw = minRawBrightness
    , bcPath = blPath
    , bcInterface = interface
    , bcName = "Clevo keyboard"
    }

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

stateFileDep :: IODependency_
stateFileDep = pathRW stateFile [Package AUR "tuxedo-keyboard"]

brightnessFileDep :: IODependency_
brightnessFileDep = pathR brightnessFile [Package AUR "tuxedo-keyboard"]

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

exportClevoKeyboard
  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
  => Maybe SesClient
  -> Sometimes (m (), m ())
exportClevoKeyboard =
  brightnessExporter
    xpfClevoBacklight
    []
    [stateFileDep, brightnessFileDep]
    clevoKeyboardConfig

clevoKeyboardControls
  :: (HasClient (DBusEnv env), MonadReader env m, MonadUnliftIO m)
  => Maybe SesClient
  -> BrightnessControls m
clevoKeyboardControls = brightnessControls xpfClevoBacklight clevoKeyboardConfig

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

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