{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-----------------------------------------------------------------------------

-----------------------------------------------------------------------------

-- |
-- Module      : System.Taffybar.Information.Backlight
-- Copyright   : (c) Ivan A. Malison
-- License     : BSD3-style (see LICENSE)
--
-- Maintainer  : Ivan A. Malison
-- Stability   : unstable
-- Portability : unportable
--
-- Simple helpers to read backlight status from /sys/class/backlight.
module System.Taffybar.Information.Backlight
  ( BacklightInfo (..),
    getBacklightDevices,
    getBacklightInfo,
    getBacklightInfoChan,
    getBacklightInfoChanWithInterval,
    getBacklightInfoState,
  )
where

import Control.Concurrent (forkIO)
import Control.Concurrent.MVar
import Control.Concurrent.STM.TChan
import Control.Exception (SomeException, bracket, catch, try)
import Control.Monad (forever, void, when)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.STM (atomically)
import Data.List (sort, sortBy)
import Data.Maybe (fromMaybe, listToMaybe)
import Data.Ord (Down (..), comparing)
import Data.Proxy (Proxy (..))
import GHC.Conc (threadWaitRead)
import GHC.TypeLits (KnownSymbol, SomeSymbol (..), Symbol, someSymbolVal)
import System.Directory (doesDirectoryExist, listDirectory)
import System.FilePath ((</>))
import System.Log.Logger (Priority (..))
import System.Taffybar.Context (TaffyIO, getStateDefault)
import System.Taffybar.Information.Udev
  ( backlightMonitorFd,
    closeBacklightMonitor,
    drainBacklightMonitor,
    openBacklightMonitor,
  )
import System.Taffybar.Information.Wakeup (getWakeupChannelForDelay)
import System.Taffybar.Util (logPrintF)
import System.Timeout (timeout)
import Text.Read (readMaybe)

backlightBasePath :: FilePath
backlightBasePath = "/sys/class/backlight"

defaultBacklightRefreshIntervalSeconds :: Double
defaultBacklightRefreshIntervalSeconds = 30

-- | Information about a backlight device.
data BacklightInfo = BacklightInfo
  { backlightDevice :: FilePath,
    backlightBrightness :: Int,
    backlightMaxBrightness :: Int,
    backlightPercent :: Int
  }
  deriving (Eq, Show)

-- | List all backlight device names under /sys/class/backlight.
getBacklightDevices :: IO [FilePath]
getBacklightDevices =
  catch (sort <$> listDirectory backlightBasePath) $ \(_ :: SomeException) ->
    return []

-- | Get backlight info for the provided device name, or (when no name is
-- provided) the "best" backlight device found under @/sys/class/backlight@.
--
-- The best device is the one with the highest @max_brightness@, which mirrors
-- Waybar's backlight selection logic.
getBacklightInfo :: Maybe FilePath -> IO (Maybe BacklightInfo)
getBacklightInfo deviceOverride = do
  device <- selectDevice deviceOverride
  case device of
    Nothing -> return Nothing
    Just dev -> readDevice dev

backlightLogPath :: String
backlightLogPath = "System.Taffybar.Information.Backlight"

backlightLogF :: (Show t) => Priority -> String -> t -> IO ()
backlightLogF = logPrintF backlightLogPath

newtype BacklightInfoChanVar (a :: Symbol)
  = BacklightInfoChanVar (TChan (Maybe BacklightInfo), MVar (Maybe BacklightInfo))

-- | Get a broadcast channel for backlight info for the provided device.
--
-- Like Waybar, this is event-driven when possible (udev netlink monitor) but
-- will still refresh at a regular interval as a fallback/sanity check.
getBacklightInfoChan :: Maybe FilePath -> TaffyIO (TChan (Maybe BacklightInfo))
getBacklightInfoChan deviceOverride =
  getBacklightInfoChanWithInterval deviceOverride defaultBacklightRefreshIntervalSeconds

-- | Like 'getBacklightInfoChan', but allows customizing the refresh interval
-- (in seconds).
--
-- Note: the first call for a given device key wins if multiple callers request
-- different intervals, because the underlying monitoring thread is cached in
-- 'Context' via 'getStateDefault'.
getBacklightInfoChanWithInterval :: Maybe FilePath -> Double -> TaffyIO (TChan (Maybe BacklightInfo))
getBacklightInfoChanWithInterval deviceOverride intervalSeconds =
  case someSymbolVal (fromMaybe "__default__" deviceOverride) of
    SomeSymbol (Proxy :: Proxy sym) ->
      getBacklightInfoChanFor @sym deviceOverride intervalSeconds

-- | Read the most recent backlight info state for the provided device.
--
-- See 'getBacklightInfoChan' for monitoring behavior.
getBacklightInfoState :: Maybe FilePath -> TaffyIO (Maybe BacklightInfo)
getBacklightInfoState deviceOverride =
  case someSymbolVal (fromMaybe "__default__" deviceOverride) of
    SomeSymbol (Proxy :: Proxy sym) -> getBacklightInfoStateFor @sym deviceOverride

getBacklightInfoChanFor ::
  forall (a :: Symbol).
  (KnownSymbol a) =>
  Maybe FilePath ->
  Double ->
  TaffyIO (TChan (Maybe BacklightInfo))
getBacklightInfoChanFor deviceOverride intervalSeconds = do
  BacklightInfoChanVar (chan, _) <-
    getBacklightInfoChanVarFor @a deviceOverride intervalSeconds
  pure chan

getBacklightInfoStateFor ::
  forall (a :: Symbol).
  (KnownSymbol a) =>
  Maybe FilePath ->
  TaffyIO (Maybe BacklightInfo)
getBacklightInfoStateFor deviceOverride = do
  BacklightInfoChanVar (_, var) <-
    getBacklightInfoChanVarFor @a deviceOverride defaultBacklightRefreshIntervalSeconds
  liftIO $ readMVar var

getBacklightInfoChanVarFor ::
  forall (a :: Symbol).
  (KnownSymbol a) =>
  Maybe FilePath ->
  Double ->
  TaffyIO (BacklightInfoChanVar a)
getBacklightInfoChanVarFor deviceOverride intervalSeconds =
  getStateDefault $ do
    wakeupChan <- getWakeupChannelForDelay (max 0.000001 intervalSeconds)
    ourWakeupChan <- liftIO $ atomically $ dupTChan wakeupChan
    liftIO $ do
      chan <- newBroadcastTChanIO
      var <- newMVar Nothing
      _ <- forkIO $ monitorBacklightInfo deviceOverride intervalSeconds ourWakeupChan chan var
      pure $ BacklightInfoChanVar (chan, var)

monitorBacklightInfo ::
  Maybe FilePath ->
  Double ->
  TChan a ->
  TChan (Maybe BacklightInfo) ->
  MVar (Maybe BacklightInfo) ->
  IO ()
monitorBacklightInfo deviceOverride intervalSeconds wakeupChan chan var = do
  let intervalMicros :: Int
      intervalMicros = max 1 (floor (intervalSeconds * 1000000))

      writeInfo info = do
        old <- swapMVar var info
        when (info /= old) $ atomically $ writeTChan chan info

      refresh = getBacklightInfo deviceOverride >>= writeInfo

      pollingFallback e = do
        -- Polling is a last resort, but we prefer it to a stuck widget.
        backlightLogF WARNING "Backlight udev monitor unavailable, falling back to polling: %s" e
        refresh
        forever $ do
          void $ atomically $ readTChan wakeupChan
          refresh

  monitorResult <- try openBacklightMonitor
  case monitorResult of
    Left (e :: SomeException) -> pollingFallback e
    Right mon -> bracket (pure mon) closeBacklightMonitor $ \m -> do
      refresh
      forever $ do
        -- Wait for a udev event or time out for a periodic refresh (Waybar-style).
        mEvent <- timeout intervalMicros $ threadWaitRead (backlightMonitorFd m)
        -- Only read from the udev socket if we were woken due to readability.
        -- Otherwise udev_monitor_receive_device can block.
        case mEvent of
          Nothing -> pure ()
          Just () -> drainBacklightMonitor m
        refresh

selectDevice :: Maybe FilePath -> IO (Maybe FilePath)
selectDevice (Just device) = do
  let path = backlightBasePath </> device
  exists <- doesDirectoryExist path
  if exists then pure (Just device) else selectDevice Nothing
selectDevice Nothing = do
  devices <- getBacklightDevices
  candidates <- mapM (\d -> (d,) . fromMaybe 0 <$> readMaxBrightness d) devices
  pure $ fst <$> listToMaybe (sortBy (comparing (Down . snd)) candidates)

readDevice :: FilePath -> IO (Maybe BacklightInfo)
readDevice device = do
  let basePath = backlightBasePath </> device
  mActual <- readIntFile (basePath </> "actual_brightness")
  brightness <- case mActual of
    Just v -> pure (Just v)
    Nothing -> readIntFile (basePath </> "brightness")
  maxBrightness <- readIntFile (basePath </> "max_brightness")
  case (brightness, maxBrightness) of
    (Just current, Just maxVal) | maxVal > 0 -> do
      let percent = round $ (fromIntegral current * 100 :: Double) / fromIntegral maxVal
      return $
        Just
          BacklightInfo
            { backlightDevice = device,
              backlightBrightness = current,
              backlightMaxBrightness = maxVal,
              backlightPercent = percent
            }
    _ -> return Nothing

readMaxBrightness :: FilePath -> IO (Maybe Int)
readMaxBrightness device =
  readIntFile (backlightBasePath </> device </> "max_brightness")

readIntFile :: FilePath -> IO (Maybe Int)
readIntFile path =
  catch
    ( do
        contents <- readFile path
        case words contents of
          (val : _) -> return $ readMaybe val
          _ -> return Nothing
    )
    $ \(_ :: SomeException) -> return Nothing
