xmonad-config/lib/Xmobar/Plugins/Common.hs

{-# LANGUAGE OverloadedStrings #-}

module Xmobar.Plugins.Common
  ( colorText
  , startListener
  , procSignalMatch
  , na
  , fromSingletonVariant
  , withDBusClientConnection
  , Callback
  , Colors(..)
  , displayMaybe
  , displayMaybe_
  , xmobarFGColor
  )
  where

import           Data.Internal.DBus

import           DBus
import           DBus.Client

import           RIO
import qualified RIO.Text                as T

import           XMonad.Hooks.DynamicLog (xmobarColor)

-- use string here since all the callbacks in xmobar use strings :(
type Callback = String -> IO ()

data Colors = Colors
  { colorsOn  :: T.Text
  , colorsOff :: T.Text
  }
  deriving (Eq, Show, Read)

startListener :: (MonadIO m, SafeClient c, IsVariant a) => MatchRule -> (c -> m [Variant])
  -> ([Variant] -> SignalMatch a) -> (a -> IO T.Text) -> Callback
  -> c -> m ()
startListener rule getProp fromSignal toColor cb client = do
  reply <- getProp client
  displayMaybe cb (liftIO . toColor) $ fromSingletonVariant reply
  void $ addMatchCallback rule (procMatch . fromSignal) client
  where
    procMatch = procSignalMatch cb toColor

procSignalMatch
  :: Callback
  -> (a -> IO T.Text)
  -> SignalMatch a
  -> IO ()
procSignalMatch cb f = withSignalMatch (displayMaybe cb f)

colorText :: Colors -> Bool -> T.Text -> T.Text
colorText Colors { colorsOn = c } True   = xmobarFGColor c
colorText Colors { colorsOff = c } False = xmobarFGColor c

xmobarFGColor :: T.Text -> T.Text -> T.Text
xmobarFGColor c = T.pack . xmobarColor (T.unpack c) "" . T.unpack

na :: T.Text
na = "N/A"

displayMaybe :: (MonadIO m) => Callback -> (a -> m T.Text) -> Maybe a -> m ()
displayMaybe cb f = (liftIO . cb . T.unpack) <=< maybe (return na) f

displayMaybe_ :: MonadIO m => Callback -> (a -> m ()) -> Maybe a -> m ()
displayMaybe_ cb = maybe (liftIO $ cb $ T.unpack na)

withDBusClientConnection
  :: (SafeClient c)
  => Callback
  -> (c -> RIO SimpleApp ())
  -> IO ()
withDBusClientConnection cb f = do
  -- TODO be more sophisticated
  runSimpleApp $ withDBusClient_ $ displayMaybe_ cb f . Just