lib/Data/Internal/DBus.hs

@@ -28,13 +28,13 @@ module Data.Internal.DBus
   )
 where
 
+import Control.Exception
 import Control.Monad
 import DBus
 import DBus.Client
 import Data.Bifunctor
 import qualified Data.Map.Strict as M
 import Data.Maybe
-import RIO
 import qualified RIO.Text as T
 
 --------------------------------------------------------------------------------
@@ -43,23 +43,23 @@ import qualified RIO.Text as T
 class SafeClient c where
   toClient :: c -> Client
 
-  getDBusClient :: MonadUnliftIO m => m (Maybe c)
+  getDBusClient :: IO (Maybe c)
 
-  disconnectDBusClient :: MonadUnliftIO m => c -> m ()
+  disconnectDBusClient :: c -> IO ()
-  disconnectDBusClient = liftIO . disconnect . toClient
+  disconnectDBusClient = disconnect . toClient
 
-  withDBusClient :: MonadUnliftIO m => (c -> m a) -> m (Maybe a)
+  withDBusClient :: (c -> IO a) -> IO (Maybe a)
   withDBusClient f = do
     client <- getDBusClient
     forM client $ \c -> do
       r <- f c
-      liftIO $ disconnect (toClient c)
+      disconnect (toClient c)
       return r
 
-  withDBusClient_ :: MonadUnliftIO m => (c -> m ()) -> m ()
+  withDBusClient_ :: (c -> IO ()) -> IO ()
   withDBusClient_ = void . withDBusClient
 
-  fromDBusClient :: MonadUnliftIO m => (c -> a) -> m (Maybe a)
+  fromDBusClient :: (c -> a) -> IO (Maybe a)
   fromDBusClient f = withDBusClient (return . f)
 
 newtype SysClient = SysClient Client
@@ -76,11 +76,11 @@ instance SafeClient SesClient where
 
   getDBusClient = fmap SesClient <$> getDBusClient' False
 
-getDBusClient' :: MonadUnliftIO m => Bool -> m (Maybe Client)
+getDBusClient' :: Bool -> IO (Maybe Client)
 getDBusClient' sys = do
-  res <- try $ liftIO $ if sys then connectSystem else connectSession
+  res <- try $ if sys then connectSystem else connectSession
   case res of
-    Left e -> liftIO $ putStrLn (clientErrorMessage e) >> return Nothing
+    Left e -> putStrLn (clientErrorMessage e) >> return Nothing
     Right c -> return $ Just c
 
 --------------------------------------------------------------------------------
@@ -88,20 +88,19 @@ getDBusClient' sys = do
 
 type MethodBody = Either T.Text [Variant]
 
-callMethod' :: (MonadUnliftIO m, SafeClient c) => c -> MethodCall -> m MethodBody
+callMethod' :: SafeClient c => c -> MethodCall -> IO MethodBody
 callMethod' cl =
-  liftIO
+  fmap (bimap (T.pack . methodErrorMessage) methodReturnBody)
-    . fmap (bimap (T.pack . methodErrorMessage) methodReturnBody)
     . call (toClient cl)
 
 callMethod
-  :: (MonadUnliftIO m, SafeClient c)
+  :: SafeClient c
   => c
   -> BusName
   -> ObjectPath
   -> InterfaceName
   -> MemberName
-  -> m MethodBody
+  -> IO MethodBody
 callMethod client bus path iface = callMethod' client . methodCallBus bus path iface
 
 methodCallBus :: BusName -> ObjectPath -> InterfaceName -> MemberName -> MethodCall
@@ -116,7 +115,7 @@ methodCallBus b p i m =
 dbusInterface :: InterfaceName
 dbusInterface = interfaceName_ "org.freedesktop.DBus"
 
-callGetNameOwner :: (MonadUnliftIO m, SafeClient c) => c -> BusName -> m (Maybe BusName)
+callGetNameOwner :: SafeClient c => c -> BusName -> IO (Maybe BusName)
 callGetNameOwner cl name = bodyToMaybe <$> callMethod' cl mc
   where
     mc =
@@ -137,16 +136,15 @@ bodyToMaybe = either (const Nothing) fromSingletonVariant
 --------------------------------------------------------------------------------
 -- Signals
 
-type SignalCallback m = [Variant] -> m ()
+type SignalCallback = [Variant] -> IO ()
 
 addMatchCallback
-  :: (MonadUnliftIO m, SafeClient c)
+  :: SafeClient c
   => MatchRule
-  -> SignalCallback m
+  -> SignalCallback
   -> c
-  -> m SignalHandler
+  -> IO SignalHandler
-addMatchCallback rule cb cl = withRunInIO $ \run -> do
+addMatchCallback rule cb cl = addMatch (toClient cl) rule $ cb . signalBody
-  addMatch (toClient cl) rule $ run . cb . signalBody
 
 matchSignal
   :: Maybe BusName
@@ -163,13 +161,13 @@ matchSignal b p i m =
     }
 
 matchSignalFull
-  :: (MonadUnliftIO m, SafeClient c)
+  :: SafeClient c
   => c
   -> BusName
   -> Maybe ObjectPath
   -> Maybe InterfaceName
   -> Maybe MemberName
-  -> m (Maybe MatchRule)
+  -> IO (Maybe MatchRule)
 matchSignalFull client b p i m =
   fmap (\o -> matchSignal (Just o) p i m) <$> callGetNameOwner client b
 
@@ -183,35 +181,34 @@ propertySignal :: MemberName
 propertySignal = memberName_ "PropertiesChanged"
 
 callPropertyGet
-  :: (MonadUnliftIO m, SafeClient c)
+  :: SafeClient c
   => BusName
   -> ObjectPath
   -> InterfaceName
   -> MemberName
   -> c
-  -> m [Variant]
+  -> IO [Variant]
 callPropertyGet bus path iface property cl =
-  liftIO $
+  fmap (either (const []) (: [])) $
-    fmap (either (const []) (: [])) $
+    getProperty (toClient cl) $
-      getProperty (toClient cl) $
+      methodCallBus bus path iface property
-        methodCallBus bus path iface property
 
 matchProperty :: Maybe BusName -> Maybe ObjectPath -> MatchRule
 matchProperty b p =
   matchSignal b p (Just propertyInterface) (Just propertySignal)
 
 matchPropertyFull
-  :: (MonadUnliftIO m, SafeClient c)
+  :: SafeClient c
   => c
   -> BusName
   -> Maybe ObjectPath
-  -> m (Maybe MatchRule)
+  -> IO (Maybe MatchRule)
 matchPropertyFull cl b p =
   matchSignalFull cl b p (Just propertyInterface) (Just propertySignal)
 
 data SignalMatch a = Match a | NoMatch | Failure deriving (Eq, Show)
 
-withSignalMatch :: MonadUnliftIO m => (Maybe a -> m ()) -> SignalMatch a -> m ()
+withSignalMatch :: (Maybe a -> IO ()) -> SignalMatch a -> IO ()
 withSignalMatch f (Match x) = f (Just x)
 withSignalMatch f Failure = f Nothing
 withSignalMatch _ NoMatch = return ()
@@ -253,43 +250,43 @@ omInterfacesRemoved :: MemberName
 omInterfacesRemoved = memberName_ "InterfacesRemoved"
 
 callGetManagedObjects
-  :: (MonadUnliftIO m, SafeClient c)
+  :: SafeClient c
   => c
   -> BusName
   -> ObjectPath
-  -> m ObjectTree
+  -> IO ObjectTree
 callGetManagedObjects cl bus path =
   either (const M.empty) (fromMaybe M.empty . fromSingletonVariant)
     <$> callMethod cl bus path omInterface getManagedObjects
 
 addInterfaceChangedListener
-  :: (MonadUnliftIO m, SafeClient c)
+  :: SafeClient c
   => BusName
   -> MemberName
   -> ObjectPath
-  -> SignalCallback m
+  -> SignalCallback
   -> c
-  -> m (Maybe SignalHandler)
+  -> IO (Maybe SignalHandler)
 addInterfaceChangedListener bus prop path sc cl = do
   rule <- matchSignalFull cl bus (Just path) (Just omInterface) (Just prop)
   forM rule $ \r -> addMatchCallback r sc cl
 
 addInterfaceAddedListener
-  :: (MonadUnliftIO m, SafeClient c)
+  :: SafeClient c
   => BusName
   -> ObjectPath
-  -> SignalCallback m
+  -> SignalCallback
   -> c
-  -> m (Maybe SignalHandler)
+  -> IO (Maybe SignalHandler)
 addInterfaceAddedListener bus =
   addInterfaceChangedListener bus omInterfacesAdded
 
 addInterfaceRemovedListener
-  :: (MonadUnliftIO m, SafeClient c)
+  :: SafeClient c
   => BusName
   -> ObjectPath
-  -> SignalCallback m
+  -> SignalCallback
   -> c
-  -> m (Maybe SignalHandler)
+  -> IO (Maybe SignalHandler)
 addInterfaceRemovedListener bus =
   addInterfaceChangedListener bus omInterfacesRemoved

lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs

@@ -13,10 +13,11 @@ module XMonad.Internal.DBus.Brightness.ClevoKeyboard
   )
 where
 
+import Control.Monad (when)
 import DBus
+import Data.Int (Int32)
 import Data.Internal.DBus
 import Data.Internal.Dependency
-import RIO
 import RIO.FilePath
 import XMonad.Internal.DBus.Brightness.Common
 import XMonad.Internal.IO
@@ -126,12 +127,8 @@ exportClevoKeyboard =
 clevoKeyboardControls :: Maybe SesClient -> BrightnessControls
 clevoKeyboardControls = brightnessControls xpfClevoBacklight clevoKeyboardConfig
 
-callGetBrightnessCK :: MonadUnliftIO m => SesClient -> m (Maybe Brightness)
+callGetBrightnessCK :: SesClient -> IO (Maybe Brightness)
 callGetBrightnessCK = callGetBrightness clevoKeyboardConfig
 
-matchSignalCK
+matchSignalCK :: (Maybe Brightness -> IO ()) -> SesClient -> IO ()
-  :: MonadUnliftIO m
-  => (Maybe Brightness -> m ())
-  -> SesClient
-  -> m ()
 matchSignalCK = matchSignal clevoKeyboardConfig

lib/XMonad/Internal/DBus/Brightness/Common.hs

@@ -14,12 +14,13 @@ module XMonad.Internal.DBus.Brightness.Common
   )
 where
 
+import Control.Monad (void)
 import DBus
 import DBus.Client
 import qualified DBus.Introspection as I
+import Data.Int (Int32)
 import Data.Internal.DBus
 import Data.Internal.Dependency
-import RIO
 import qualified RIO.Text as T
 import XMonad.Core (io)
 import XMonad.Internal.DBus.Common
@@ -68,10 +69,10 @@ brightnessControls q bc cl =
     cb = callBacklight q cl bc
 
 callGetBrightness
-  :: (MonadUnliftIO m, SafeClient c, Num n)
+  :: (SafeClient c, Num n)
   => BrightnessConfig a b
   -> c
-  -> m (Maybe n)
+  -> IO (Maybe n)
 callGetBrightness BrightnessConfig {bcPath = p, bcInterface = i} client =
   either (const Nothing) bodyGetBrightness
     <$> callMethod client xmonadBusName p i memGet
@@ -81,11 +82,11 @@ signalDep BrightnessConfig {bcPath = p, bcInterface = i} =
   Endpoint [] xmonadBusName p i $ Signal_ memCur
 
 matchSignal
-  :: (MonadUnliftIO m, SafeClient c, Num n)
+  :: (SafeClient c, Num n)
   => BrightnessConfig a b
-  -> (Maybe n -> m ())
+  -> (Maybe n -> IO ())
   -> c
-  -> m ()
+  -> IO ()
 matchSignal BrightnessConfig {bcPath = p, bcInterface = i} cb =
   void . addMatchCallback brMatcher (cb . bodyGetBrightness)
   where
@@ -114,11 +115,7 @@ brightnessExporter q ful deps bc@BrightnessConfig {bcName = n} cl =
     root = DBusRoot_ (exportBrightnessControls' bc) tree cl
     tree = listToAnds (Bus ful xmonadBusName) $ fmap DBusIO deps
 
-exportBrightnessControls'
+exportBrightnessControls' :: RealFrac b => BrightnessConfig a b -> SesClient -> FIO ()
-  :: (MonadUnliftIO m, RealFrac b)
-  => BrightnessConfig a b
-  -> SesClient
-  -> m ()
 exportBrightnessControls' bc cl = io $ do
   let ses = toClient cl
   maxval <- bcGetMax bc -- assume the max value will never change
@@ -151,14 +148,9 @@ exportBrightnessControls' bc cl = io $ do
             ]
         }
 
-emitBrightness
+emitBrightness :: RealFrac b => BrightnessConfig a b -> Client -> b -> IO ()
-  :: (MonadUnliftIO m, RealFrac b)
-  => BrightnessConfig a b
-  -> Client
-  -> b
-  -> m ()
 emitBrightness BrightnessConfig {bcPath = p, bcInterface = i} client cur =
-  liftIO $ emit client $ sig {signalBody = [toVariant (round cur :: Int32)]}
+  emit client $ sig {signalBody = [toVariant (round cur :: Int32)]}
   where
     sig = signal p i memCur
 

lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs

@@ -14,9 +14,9 @@ module XMonad.Internal.DBus.Brightness.IntelBacklight
 where
 
 import DBus
+import Data.Int (Int32)
 import Data.Internal.DBus
 import Data.Internal.Dependency
-import RIO
 import RIO.FilePath
 import XMonad.Internal.DBus.Brightness.Common
 import XMonad.Internal.IO
@@ -110,12 +110,8 @@ exportIntelBacklight =
 intelBacklightControls :: Maybe SesClient -> BrightnessControls
 intelBacklightControls = brightnessControls xpfIntelBacklight intelBacklightConfig
 
-callGetBrightnessIB :: MonadUnliftIO m => SesClient -> m (Maybe Brightness)
+callGetBrightnessIB :: SesClient -> IO (Maybe Brightness)
 callGetBrightnessIB = callGetBrightness intelBacklightConfig
 
-matchSignalIB
+matchSignalIB :: (Maybe Brightness -> IO ()) -> SesClient -> IO ()
-  :: MonadUnliftIO m
-  => (Maybe Brightness -> m ())
-  -> SesClient
-  -> m ()
 matchSignalIB = matchSignal intelBacklightConfig

lib/XMonad/Internal/DBus/Control.hs

@@ -18,11 +18,11 @@ module XMonad.Internal.DBus.Control
   )
 where
 
+import Control.Monad
 import DBus
 import DBus.Client
 import Data.Internal.DBus
 import Data.Internal.Dependency
-import RIO
 import XMonad.Internal.DBus.Brightness.ClevoKeyboard
 import XMonad.Internal.DBus.Brightness.IntelBacklight
 import XMonad.Internal.DBus.Common
@@ -35,27 +35,27 @@ data DBusState = DBusState
   }
 
 -- | Connect to the DBus
-connectDBus :: MonadUnliftIO m => m DBusState
+connectDBus :: IO DBusState
 connectDBus = do
   ses <- getDBusClient
   sys <- getDBusClient
   return DBusState {dbSesClient = ses, dbSysClient = sys}
 
 -- | Disconnect from the DBus
-disconnectDBus :: MonadUnliftIO m => DBusState -> m ()
+disconnectDBus :: DBusState -> IO ()
 disconnectDBus db = disc dbSesClient >> disc dbSysClient
   where
     disc f = maybe (return ()) disconnectDBusClient $ f db
 
 -- | Connect to the DBus and request the XMonad name
-connectDBusX :: MonadUnliftIO m => m DBusState
+connectDBusX :: IO DBusState
 connectDBusX = do
   db <- connectDBus
   forM_ (dbSesClient db) requestXMonadName
   return db
 
 -- | Disconnect from DBus and release the XMonad name
-disconnectDBusX :: MonadUnliftIO m => DBusState -> m ()
+disconnectDBusX :: DBusState -> IO ()
 disconnectDBusX db = do
   forM_ (dbSesClient db) releaseXMonadName
   disconnectDBus db
@@ -64,12 +64,12 @@ disconnectDBusX db = do
 dbusExporters :: [Maybe SesClient -> SometimesIO]
 dbusExporters = [exportScreensaver, exportIntelBacklight, exportClevoKeyboard]
 
-releaseXMonadName :: MonadUnliftIO m => SesClient -> m ()
+releaseXMonadName :: SesClient -> IO ()
-releaseXMonadName ses = liftIO $ void $ releaseName (toClient ses) xmonadBusName
+releaseXMonadName ses = void $ releaseName (toClient ses) xmonadBusName
 
-requestXMonadName :: MonadUnliftIO m => SesClient -> m ()
+requestXMonadName :: SesClient -> IO ()
 requestXMonadName ses = do
-  res <- liftIO $ requestName (toClient ses) xmonadBusName []
+  res <- requestName (toClient ses) xmonadBusName []
   -- TODO if the client is not released on shutdown the owner will be different
   let msg
         | res == NamePrimaryOwner = Nothing
@@ -78,6 +78,6 @@ requestXMonadName ses = do
             || res == NameExists =
             Just $ "another process owns " ++ xn
         | otherwise = Just $ "unknown error when requesting " ++ xn
-  liftIO $ forM_ msg putStrLn
+  forM_ msg putStrLn
   where
     xn = "'" ++ formatBusName xmonadBusName ++ "'"

lib/Xmobar/Plugins/BacklightCommon.hs

@@ -7,21 +7,20 @@
 module Xmobar.Plugins.BacklightCommon (startBacklight) where
 
 import Data.Internal.DBus
-import RIO
 import qualified RIO.Text as T
 import Xmobar.Plugins.Common
 
 startBacklight
-  :: (MonadUnliftIO m, RealFrac a)
+  :: RealFrac a
-  => ((Maybe a -> m ()) -> SesClient -> m ())
+  => ((Maybe a -> IO ()) -> SesClient -> IO ())
-  -> (SesClient -> m (Maybe a))
+  -> (SesClient -> IO (Maybe a))
   -> T.Text
   -> Callback
-  -> m ()
+  -> IO ()
 startBacklight matchSignal callGetBrightness icon cb = do
   withDBusClientConnection cb $ \c -> do
-    matchSignal dpy c
+    matchSignal display c
-    dpy =<< callGetBrightness c
+    display =<< callGetBrightness c
   where
     formatBrightness b = return $ T.concat [icon, T.pack $ show (round b :: Integer), "%"]
-    dpy = displayMaybe cb formatBrightness
+    display = displayMaybe cb formatBrightness

lib/Xmobar/Plugins/Bluetooth.hs

@@ -39,6 +39,7 @@ module Xmobar.Plugins.Bluetooth
   )
 where
 
+import Control.Concurrent.MVar
 import Control.Monad
 import DBus
 import DBus.Client
@@ -48,7 +49,6 @@ import Data.List
 import Data.List.Split
 import qualified Data.Map as M
 import Data.Maybe
-import RIO
 import qualified RIO.Text as T
 import XMonad.Internal.DBus.Common
 import Xmobar
@@ -69,29 +69,23 @@ instance Exec Bluetooth where
   start (Bluetooth icons colors) cb =
     withDBusClientConnection cb $ startAdapter icons colors cb
 
-startAdapter
+startAdapter :: Icons -> Colors -> Callback -> SysClient -> IO ()
-  :: MonadUnliftIO m
-  => Icons
-  -> Colors
-  -> Callback
-  -> SysClient
-  -> m ()
 startAdapter is cs cb cl = do
   ot <- getBtObjectTree cl
   state <- newMVar emptyState
-  let dpy = displayIcon cb (iconFormatter is cs) state
+  let display = displayIcon cb (iconFormatter is cs) state
   forM_ (findAdapter ot) $ \adapter -> do
     -- set up adapter
     initAdapter state adapter cl
     -- TODO this step could fail; at least warn the user...
-    void $ addAdaptorListener state dpy adapter cl
+    void $ addAdaptorListener state display adapter cl
     -- set up devices on the adapter (and listeners for adding/removing devices)
     let devices = findDevices adapter ot
-    addDeviceAddedListener state dpy adapter cl
+    addDeviceAddedListener state display adapter cl
-    addDeviceRemovedListener state dpy adapter cl
+    addDeviceRemovedListener state display adapter cl
-    forM_ devices $ \d -> addAndInitDevice state dpy d cl
+    forM_ devices $ \d -> addAndInitDevice state display d cl
     -- after setting things up, show the icon based on the initialized state
-    dpy
+    display
 
 --------------------------------------------------------------------------------
 -- Icon Display
@@ -103,9 +97,9 @@ type IconFormatter = (Maybe Bool -> Bool -> T.Text)
 
 type Icons = (T.Text, T.Text)
 
-displayIcon :: MonadUnliftIO m => Callback -> IconFormatter -> MutableBtState -> m ()
+displayIcon :: Callback -> IconFormatter -> MutableBtState -> IO ()
 displayIcon callback formatter =
-  liftIO . callback . T.unpack . uncurry formatter <=< readState
+  callback . T.unpack . uncurry formatter <=< readState
 
 -- TODO maybe I want this to fail when any of the device statuses are Nothing
 iconFormatter :: Icons -> Colors -> IconFormatter
@@ -143,7 +137,7 @@ emptyState =
     , btPowered = Nothing
     }
 
-readState :: MonadUnliftIO m => MutableBtState -> m (Maybe Bool, Bool)
+readState :: MutableBtState -> IO (Maybe Bool, Bool)
 readState state = do
   p <- readPowered state
   c <- readDevices state
@@ -166,81 +160,59 @@ adaptorHasDevice adaptor device = case splitPath device of
 splitPath :: ObjectPath -> [T.Text]
 splitPath = fmap T.pack . splitOn "/" . dropWhile (== '/') . formatObjectPath
 
-getBtObjectTree :: MonadUnliftIO m => SysClient -> m ObjectTree
+getBtObjectTree :: SysClient -> IO ObjectTree
 getBtObjectTree sys = callGetManagedObjects sys btBus btOMPath
 
 btOMPath :: ObjectPath
 btOMPath = objectPath_ "/"
 
-addBtOMListener :: MonadUnliftIO m => SignalCallback m -> SysClient -> m ()
+addBtOMListener :: SignalCallback -> SysClient -> IO ()
 addBtOMListener sc = void . addInterfaceAddedListener btBus btOMPath sc
 
-addDeviceAddedListener
+addDeviceAddedListener :: MutableBtState -> IO () -> ObjectPath -> SysClient -> IO ()
-  :: MonadUnliftIO m
+addDeviceAddedListener state display adapter client =
-  => MutableBtState
-  -> m ()
-  -> ObjectPath
-  -> SysClient
-  -> m ()
-addDeviceAddedListener state dpy adapter client =
   addBtOMListener addDevice client
   where
-    addDevice = pathCallback adapter dpy $ \d ->
+    addDevice = pathCallback adapter display $ \d ->
-      addAndInitDevice state dpy d client
+      addAndInitDevice state display d client
 
-addDeviceRemovedListener
+addDeviceRemovedListener :: MutableBtState -> IO () -> ObjectPath -> SysClient -> IO ()
-  :: (MonadUnliftIO m)
+addDeviceRemovedListener state display adapter sys =
-  => MutableBtState
-  -> m ()
-  -> ObjectPath
-  -> SysClient
-  -> m ()
-addDeviceRemovedListener state dpy adapter sys =
   addBtOMListener remDevice sys
   where
-    remDevice = pathCallback adapter dpy $ \d -> do
+    remDevice = pathCallback adapter display $ \d -> do
       old <- removeDevice state d
-      forM_ old $ liftIO . removeMatch (toClient sys) . btDevSigHandler
+      forM_ old $ removeMatch (toClient sys) . btDevSigHandler
 
-pathCallback :: MonadUnliftIO m => ObjectPath -> m () -> (ObjectPath -> m ()) -> SignalCallback m
+pathCallback :: ObjectPath -> IO () -> (ObjectPath -> IO ()) -> SignalCallback
-pathCallback adapter dpy f [device, _] = forM_ (fromVariant device) $ \d ->
+pathCallback adapter display f [device, _] = forM_ (fromVariant device) $ \d ->
-  when (adaptorHasDevice adapter d) $ f d >> dpy
+  when (adaptorHasDevice adapter d) $ f d >> display
 pathCallback _ _ _ _ = return ()
 
 --------------------------------------------------------------------------------
 -- Adapter
 
-initAdapter
+initAdapter :: MutableBtState -> ObjectPath -> SysClient -> IO ()
-  :: (MonadUnliftIO m)
-  => MutableBtState
-  -> ObjectPath
-  -> SysClient
-  -> m ()
 initAdapter state adapter client = do
   reply <- callGetPowered adapter client
   putPowered state $ fromSingletonVariant reply
 
-matchBTProperty
+matchBTProperty :: SysClient -> ObjectPath -> IO (Maybe MatchRule)
-  :: (MonadUnliftIO m)
-  => SysClient
-  -> ObjectPath
-  -> m (Maybe MatchRule)
 matchBTProperty sys p = matchPropertyFull sys btBus (Just p)
 
 addAdaptorListener
-  :: MonadUnliftIO m
+  :: MutableBtState
-  => MutableBtState
+  -> IO ()
-  -> m ()
   -> ObjectPath
   -> SysClient
-  -> m (Maybe SignalHandler)
+  -> IO (Maybe SignalHandler)
-addAdaptorListener state dpy adaptor sys = do
+addAdaptorListener state display adaptor sys = do
   rule <- matchBTProperty sys adaptor
   forM rule $ \r -> addMatchCallback r (procMatch . matchPowered) sys
   where
-    procMatch = withSignalMatch $ \b -> putPowered state b >> dpy
+    procMatch = withSignalMatch $ \b -> putPowered state b >> display
 
-callGetPowered :: MonadUnliftIO m => ObjectPath -> SysClient -> m [Variant]
+callGetPowered :: ObjectPath -> SysClient -> IO [Variant]
 callGetPowered adapter =
   callPropertyGet btBus adapter adapterInterface $
     memberName_ $
@@ -249,10 +221,10 @@ callGetPowered adapter =
 matchPowered :: [Variant] -> SignalMatch Bool
 matchPowered = matchPropertyChanged adapterInterface adaptorPowered
 
-putPowered :: MonadUnliftIO m => MutableBtState -> Maybe Bool -> m ()
+putPowered :: MutableBtState -> Maybe Bool -> IO ()
 putPowered m ds = modifyMVar_ m (\s -> return s {btPowered = ds})
 
-readPowered :: MonadUnliftIO m => MutableBtState -> m (Maybe Bool)
+readPowered :: MutableBtState -> IO (Maybe Bool)
 readPowered = fmap btPowered . readMVar
 
 adapterInterface :: InterfaceName
@@ -264,25 +236,13 @@ adaptorPowered = "Powered"
 --------------------------------------------------------------------------------
 -- Devices
 
-addAndInitDevice
+addAndInitDevice :: MutableBtState -> IO () -> ObjectPath -> SysClient -> IO ()
-  :: MonadUnliftIO m
+addAndInitDevice state display device client = do
-  => MutableBtState
+  sh <- addDeviceListener state display device client
-  -> m ()
-  -> ObjectPath
-  -> SysClient
-  -> m ()
-addAndInitDevice state dpy device client = do
-  sh <- addDeviceListener state dpy device client
   -- TODO add some intelligent error messages here
   forM_ sh $ \s -> initDevice state s device client
 
-initDevice
+initDevice :: MutableBtState -> SignalHandler -> ObjectPath -> SysClient -> IO ()
-  :: MonadUnliftIO m
-  => MutableBtState
-  -> SignalHandler
-  -> ObjectPath
-  -> SysClient
-  -> m ()
 initDevice state sh device sys = do
   reply <- callGetConnected device sys
   void $
@@ -293,42 +253,31 @@ initDevice state sh device sys = do
         }
 
 addDeviceListener
-  :: MonadUnliftIO m
+  :: MutableBtState
-  => MutableBtState
+  -> IO ()
-  -> m ()
   -> ObjectPath
   -> SysClient
-  -> m (Maybe SignalHandler)
+  -> IO (Maybe SignalHandler)
-addDeviceListener state dpy device sys = do
+addDeviceListener state display device sys = do
   rule <- matchBTProperty sys device
   forM rule $ \r -> addMatchCallback r (procMatch . matchConnected) sys
   where
-    procMatch = withSignalMatch $ \c -> updateDevice state device c >> dpy
+    procMatch = withSignalMatch $ \c -> updateDevice state device c >> display
 
 matchConnected :: [Variant] -> SignalMatch Bool
 matchConnected = matchPropertyChanged devInterface devConnected
 
-callGetConnected :: MonadUnliftIO m => ObjectPath -> SysClient -> m [Variant]
+callGetConnected :: ObjectPath -> SysClient -> IO [Variant]
 callGetConnected p =
   callPropertyGet btBus p devInterface $
     memberName_ (T.unpack devConnected)
 
-insertDevice
+insertDevice :: MutableBtState -> ObjectPath -> BTDevice -> IO Bool
-  :: MonadUnliftIO m
-  => MutableBtState
-  -> ObjectPath
-  -> BTDevice
-  -> m Bool
 insertDevice m device dev = modifyMVar m $ \s -> do
   let new = M.insert device dev $ btDevices s
   return (s {btDevices = new}, anyDevicesConnected new)
 
-updateDevice
+updateDevice :: MutableBtState -> ObjectPath -> Maybe Bool -> IO Bool
-  :: MonadUnliftIO m
-  => MutableBtState
-  -> ObjectPath
-  -> Maybe Bool
-  -> m Bool
 updateDevice m device status = modifyMVar m $ \s -> do
   let new = M.update (\d -> Just d {btDevConnected = status}) device $ btDevices s
   return (s {btDevices = new}, anyDevicesConnected new)
@@ -336,16 +285,12 @@ updateDevice m device status = modifyMVar m $ \s -> do
 anyDevicesConnected :: ConnectedDevices -> Bool
 anyDevicesConnected = or . mapMaybe btDevConnected . M.elems
 
-removeDevice
+removeDevice :: MutableBtState -> ObjectPath -> IO (Maybe BTDevice)
-  :: MonadUnliftIO m
-  => MutableBtState
-  -> ObjectPath
-  -> m (Maybe BTDevice)
 removeDevice m device = modifyMVar m $ \s -> do
   let devs = btDevices s
   return (s {btDevices = M.delete device devs}, M.lookup device devs)
 
-readDevices :: MonadUnliftIO m => MutableBtState -> m ConnectedDevices
+readDevices :: MutableBtState -> IO ConnectedDevices
 readDevices = fmap btDevices . readMVar
 
 devInterface :: InterfaceName

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
-  :: (MonadUnliftIO m, SafeClient c, IsVariant a)
+  :: (SafeClient c, IsVariant a)
   => MatchRule
-  -> (c -> m [Variant])
+  -> (c -> IO [Variant])
   -> ([Variant] -> SignalMatch a)
-  -> (a -> m T.Text)
+  -> (a -> IO T.Text)
   -> Callback
   -> c
-  -> m ()
+  -> IO ()
 startListener rule getProp fromSignal toColor cb client = do
   reply <- getProp client
   displayMaybe cb toColor $ fromSingletonVariant reply
@@ -47,8 +47,7 @@ startListener rule getProp fromSignal toColor cb client = do
   where
     procMatch = procSignalMatch cb toColor
 
-procSignalMatch
+procSignalMatch :: Callback -> (a -> IO T.Text) -> SignalMatch a -> IO ()
-  :: MonadUnliftIO m => Callback -> (a -> m T.Text) -> SignalMatch a -> m ()
 procSignalMatch cb f = withSignalMatch (displayMaybe cb f)
 
 colorText :: Colors -> Bool -> T.Text -> T.Text
@@ -61,15 +60,11 @@ xmobarFGColor c = T.pack . xmobarColor (T.unpack c) "" . T.unpack
 na :: T.Text
 na = "N/A"
 
-displayMaybe :: MonadUnliftIO m => Callback -> (a -> m T.Text) -> Maybe a -> m ()
+displayMaybe :: Callback -> (a -> IO T.Text) -> Maybe a -> IO ()
-displayMaybe cb f = (liftIO . cb . T.unpack) <=< maybe (return na) f
+displayMaybe cb f = (cb . T.unpack) <=< maybe (return na) f
 
-displayMaybe' :: MonadUnliftIO m => Callback -> (a -> m ()) -> Maybe a -> m ()
+displayMaybe' :: Callback -> (a -> IO ()) -> Maybe a -> IO ()
-displayMaybe' cb = maybe (liftIO $ cb $ T.unpack na)
+displayMaybe' cb = maybe (cb $ T.unpack na)
 
-withDBusClientConnection
+withDBusClientConnection :: SafeClient c => Callback -> (c -> IO ()) -> IO ()
-  :: (MonadUnliftIO m, SafeClient c)
-  => Callback
-  -> (c -> m ())
-  -> m ()
 withDBusClientConnection cb f = displayMaybe' cb f =<< getDBusClient

lib/Xmobar/Plugins/Device.hs

@@ -12,11 +12,11 @@ module Xmobar.Plugins.Device
   )
 where
 
+import Control.Monad
 import DBus
 import Data.Internal.DBus
 import Data.Internal.Dependency
 import Data.Word
-import RIO
 import qualified RIO.Text as T
 import XMonad.Internal.Command.Desktop
 import XMonad.Internal.DBus.Common
@@ -45,7 +45,7 @@ devDep =
   Endpoint networkManagerPkgs networkManagerBus nmPath nmInterface $
     Method_ getByIP
 
-getDevice :: MonadUnliftIO m => SysClient -> T.Text -> m (Maybe ObjectPath)
+getDevice :: SysClient -> T.Text -> IO (Maybe ObjectPath)
 getDevice sys iface = bodyToMaybe <$> callMethod' sys mc
   where
     mc =
@@ -53,7 +53,7 @@ getDevice sys iface = bodyToMaybe <$> callMethod' sys mc
         { methodCallBody = [toVariant iface]
         }
 
-getDeviceConnected :: MonadUnliftIO m => ObjectPath -> SysClient -> m [Variant]
+getDeviceConnected :: ObjectPath -> SysClient -> IO [Variant]
 getDeviceConnected path =
   callPropertyGet networkManagerBus path nmDeviceInterface $
     memberName_ $

lib/Xmobar/Plugins/VPN.hs

@@ -14,13 +14,14 @@ module Xmobar.Plugins.VPN
   )
 where
 
+import Control.Concurrent.MVar
+import Control.Monad
 import DBus
 import Data.Internal.DBus
 import Data.Internal.Dependency
 import qualified Data.Map as M
 import Data.Maybe
 import qualified Data.Set as S
-import RIO
 import qualified RIO.Text as T
 import XMonad.Internal.Command.Desktop
 import XMonad.Internal.DBus.Common
@@ -34,11 +35,11 @@ instance Exec VPN where
   start (VPN (text, colors)) cb =
     withDBusClientConnection cb $ \c -> do
       state <- initState c
-      let dpy = displayMaybe cb iconFormatter . Just =<< readState state
+      let display = displayMaybe cb iconFormatter . Just =<< readState state
-      let signalCallback' f = f state dpy
+      let signalCallback' f = f state display
       vpnAddedListener (signalCallback' addedCallback) c
       vpnRemovedListener (signalCallback' removedCallback) c
-      dpy
+      display
     where
       iconFormatter b = return $ colorText colors b text
 
@@ -53,59 +54,57 @@ type VPNState = S.Set ObjectPath
 
 type MutableVPNState = MVar VPNState
 
-initState :: MonadUnliftIO m => SysClient -> m MutableVPNState
+initState :: SysClient -> IO MutableVPNState
 initState client = do
   ot <- getVPNObjectTree client
   newMVar $ findTunnels ot
 
-readState :: MonadUnliftIO m => MutableVPNState -> m Bool
+readState :: MutableVPNState -> IO Bool
 readState = fmap (not . null) . readMVar
 
 updateState
-  :: MonadUnliftIO m
+  :: (ObjectPath -> VPNState -> VPNState)
-  => (ObjectPath -> VPNState -> VPNState)
   -> MutableVPNState
   -> ObjectPath
-  -> m ()
+  -> IO ()
 updateState f state op = modifyMVar_ state $ return . f op
 
 --------------------------------------------------------------------------------
 -- Tunnel Device Detection
 
-getVPNObjectTree :: MonadUnliftIO m => SysClient -> m ObjectTree
+getVPNObjectTree :: SysClient -> IO ObjectTree
 getVPNObjectTree sys = callGetManagedObjects sys vpnBus vpnPath
 
 findTunnels :: ObjectTree -> VPNState
 findTunnels = S.fromList . M.keys . M.filter (elem vpnDeviceTun . M.keys)
 
-vpnAddedListener :: MonadUnliftIO m => SignalCallback m -> SysClient -> m ()
+vpnAddedListener :: SignalCallback -> SysClient -> IO ()
 vpnAddedListener cb = void . addInterfaceAddedListener vpnBus vpnPath cb
 
-vpnRemovedListener :: MonadUnliftIO m => SignalCallback m -> SysClient -> m ()
+vpnRemovedListener :: SignalCallback -> SysClient -> IO ()
 vpnRemovedListener cb = void . addInterfaceRemovedListener vpnBus vpnPath cb
 
-addedCallback :: MonadUnliftIO m => MutableVPNState -> m () -> SignalCallback m
+addedCallback :: MutableVPNState -> IO () -> SignalCallback
-addedCallback state dpy [device, added] = update >> dpy
+addedCallback state display [device, added] = update >> display
   where
     added' = fromVariant added :: Maybe (M.Map T.Text (M.Map T.Text Variant))
     is = M.keys $ fromMaybe M.empty added'
     update = updateDevice S.insert state device is
 addedCallback _ _ _ = return ()
 
-removedCallback :: MonadUnliftIO m => MutableVPNState -> m () -> SignalCallback m
+removedCallback :: MutableVPNState -> IO () -> SignalCallback
-removedCallback state dpy [device, interfaces] = update >> dpy
+removedCallback state display [device, interfaces] = update >> display
   where
     is = fromMaybe [] $ fromVariant interfaces :: [T.Text]
     update = updateDevice S.delete state device is
 removedCallback _ _ _ = return ()
 
 updateDevice
-  :: MonadUnliftIO m
+  :: (ObjectPath -> VPNState -> VPNState)
-  => (ObjectPath -> VPNState -> VPNState)
   -> MutableVPNState
   -> Variant
   -> [T.Text]
-  -> m ()
+  -> IO ()
 updateDevice f state device interfaces =
   when (vpnDeviceTun `elem` interfaces) $
     forM_ d $