diff --git a/lib/Xmobar/Plugins/Common.hs b/lib/Xmobar/Plugins/Common.hs index f6bde99..98b9acc 100644 --- a/lib/Xmobar/Plugins/Common.hs +++ b/lib/Xmobar/Plugins/Common.hs @@ -15,10 +15,10 @@ module Xmobar.Plugins.Common ) where -import Control.Monad import DBus import DBus.Client import Data.Internal.DBus +import RIO import qualified RIO.Text as T import XMonad.Hooks.DynamicLog (xmobarColor) @@ -32,14 +32,14 @@ data Colors = Colors deriving (Eq, Show, Read) startListener - :: (SafeClient c, IsVariant a) + :: (MonadUnliftIO m, SafeClient c, IsVariant a) => MatchRule - -> (c -> IO [Variant]) + -> (c -> m [Variant]) -> ([Variant] -> SignalMatch a) - -> (a -> IO T.Text) + -> (a -> m T.Text) -> Callback -> c - -> IO () + -> m () startListener rule getProp fromSignal toColor cb client = do reply <- getProp client displayMaybe cb toColor $ fromSingletonVariant reply @@ -47,7 +47,8 @@ startListener rule getProp fromSignal toColor cb client = do where procMatch = procSignalMatch cb toColor -procSignalMatch :: Callback -> (a -> IO T.Text) -> SignalMatch a -> IO () +procSignalMatch + :: MonadUnliftIO m => Callback -> (a -> m T.Text) -> SignalMatch a -> m () procSignalMatch cb f = withSignalMatch (displayMaybe cb f) colorText :: Colors -> Bool -> T.Text -> T.Text @@ -60,11 +61,15 @@ xmobarFGColor c = T.pack . xmobarColor (T.unpack c) "" . T.unpack na :: T.Text na = "N/A" -displayMaybe :: Callback -> (a -> IO T.Text) -> Maybe a -> IO () -displayMaybe cb f = (cb . T.unpack) <=< maybe (return na) f +displayMaybe :: MonadUnliftIO m => Callback -> (a -> m T.Text) -> Maybe a -> m () +displayMaybe cb f = (liftIO . cb . T.unpack) <=< maybe (return na) f -displayMaybe' :: Callback -> (a -> IO ()) -> Maybe a -> IO () -displayMaybe' cb = maybe (cb $ T.unpack na) +displayMaybe' :: MonadUnliftIO m => Callback -> (a -> m ()) -> Maybe a -> m () +displayMaybe' cb = maybe (liftIO $ cb $ T.unpack na) -withDBusClientConnection :: SafeClient c => Callback -> (c -> IO ()) -> IO () +withDBusClientConnection + :: (MonadUnliftIO m, SafeClient c) + => Callback + -> (c -> m ()) + -> m () withDBusClientConnection cb f = displayMaybe' cb f =<< getDBusClient