Revert "WIP use unliftio everywhere-ish"

This reverts commit 769df2fb00.

bin/xmobar.hs

@@ -56,20 +56,17 @@ main = getArgs >>= parse
 parse :: [String] -> IO ()
 parse []         = run
 parse ["--deps"] = withCache printDeps
-parse ["--test"] = withCache $ do
+parse ["--test"] = void $ withCache . evalConfig =<< connectDBus
-  db <- connectDBus
-  void $ evalConfig db
 parse _          = usage
 
 run :: IO ()
-run =
+run = do
-  withCache $ do
   db <- connectDBus
-    c <- evalConfig db
+  c <- withCache $ evalConfig db
   disconnectDBus db
   -- this is needed to see any printed messages
-    liftIO $ hFlush stdout
+  hFlush stdout
-    liftIO $ xmobar c
+  xmobar c
 
 evalConfig :: DBusState -> FIO Config
 evalConfig db = do
@@ -81,10 +78,10 @@ evalConfig db = do
 
 printDeps :: FIO ()
 printDeps = do
-  db <- connectDBus
+  db <- io connectDBus
   let ps = sort $ nub $ fmap showFulfillment $ concatMap dumpFeature $ allFeatures db
   io $ mapM_ (putStrLn . T.unpack) ps
-  disconnectDBus db
+  io $ disconnectDBus db
 
 usage :: IO ()
 usage = putStrLn $ intercalate "\n"

bin/xmonad.hs

@@ -8,8 +8,12 @@
 
 module Main (main) where
 
+import           Control.Monad
+
 import           Data.Internal.DBus
 import           Data.Internal.Dependency
+import           Data.List
+import           Data.Maybe
 import           Data.Monoid
 import           Data.Text.IO                                   (hPutStrLn)
 
@@ -19,7 +23,6 @@ import           Graphics.X11.Xlib.Extras
 
 import           RIO
 import           RIO.Directory
-import           RIO.List
 import           RIO.Process
 import qualified RIO.Text                                       as T
 
@@ -201,7 +204,7 @@ startChildDaemons :: FeatureSet -> FIO [Process () () ()]
 startChildDaemons fs = catMaybes <$> mapM executeSometimes (fsDaemons fs)
 
 withDBusX :: (DBusState -> FIO a) -> FIO a
-withDBusX = bracket connectDBusX cleanup
+withDBusX = bracket (io connectDBusX) cleanup
   where
     cleanup db = do
       logInfo "unregistering xmonad from DBus"
@@ -223,7 +226,7 @@ withXmobar = bracket startXmobar cleanup
 
 printDeps :: FIO ()
 printDeps = do
-  db <- connectDBus
+  db <- io connectDBus
   (i, f, d) <- allFeatures db
   io $ mapM_ (putStrLn . T.unpack)
     $ fmap showFulfillment

lib/Data/Internal/DBus.hs

@@ -27,8 +27,13 @@ module Data.Internal.DBus
   , bodyToMaybe
   ) where
 
-import           RIO
+import           Control.Exception
-import qualified RIO.Map     as M
+import           Control.Monad
+
+import           Data.Bifunctor
+import qualified Data.Map.Strict   as M
+import           Data.Maybe
+
 import qualified RIO.Text          as T
 
 import           DBus
@@ -40,38 +45,23 @@ import           DBus.Client
 class SafeClient c where
   toClient :: c -> Client
 
-  getDBusClient
+  getDBusClient :: IO (Maybe c)
-    :: (MonadUnliftIO m, MonadReader env m, HasLogFunc env)
-    => m (Maybe c)
 
-  disconnectDBusClient
+  disconnectDBusClient :: c -> IO ()
-    :: (MonadUnliftIO m)
+  disconnectDBusClient = disconnect . toClient
-    => c
-    -> m ()
-  disconnectDBusClient = liftIO . disconnect . toClient
 
-  withDBusClient
+  withDBusClient :: (c -> IO a) -> IO (Maybe a)
-    :: (MonadUnliftIO m, MonadReader env m, HasLogFunc env)
-    => (c -> m a)
-    -> m (Maybe a)
-  -- TODO bracket
   withDBusClient f = do
     client <- getDBusClient
     forM client $ \c -> do
       r <- f c
-      liftIO $ disconnect (toClient c)
+      disconnect (toClient c)
       return r
 
-  withDBusClient_
+  withDBusClient_ :: (c -> IO ()) -> IO ()
-    :: (MonadUnliftIO m, MonadReader env m, HasLogFunc env)
-    => (c -> m ())
-    -> m ()
   withDBusClient_ = void . withDBusClient
 
-  fromDBusClient
+  fromDBusClient :: (c -> a) -> IO (Maybe a)
-    :: (MonadUnliftIO m, MonadReader env m, HasLogFunc env)
-    => (c -> a)
-    -> m (Maybe a)
   fromDBusClient f = withDBusClient (return . f)
 
 newtype SysClient = SysClient Client
@@ -79,25 +69,20 @@ newtype SysClient = SysClient Client
 instance SafeClient SysClient where
   toClient (SysClient cl) = cl
 
-  getDBusClient = fmap SysClient <$> getDBusClient_ True
+  getDBusClient = fmap SysClient <$> getDBusClient' True
 
 newtype SesClient = SesClient Client
 
 instance SafeClient SesClient where
   toClient (SesClient cl) = cl
 
-  getDBusClient = fmap SesClient <$> getDBusClient_ False
+  getDBusClient = fmap SesClient <$> getDBusClient' False
 
-getDBusClient_
+getDBusClient' :: Bool -> IO (Maybe Client)
-  :: (MonadUnliftIO m, MonadReader env m, HasLogFunc env)
+getDBusClient' sys = do
-  => Bool
+  res <- try $ if sys then connectSystem else connectSession
-  -> m (Maybe Client)
-getDBusClient_ sys = do
-  res <- try $ liftIO $ if sys then connectSystem else connectSession
   case res of
-    Left e  -> do
+    Left e  -> putStrLn (clientErrorMessage e) >> return Nothing
-      logError $ Utf8Builder $ encodeUtf8Builder $ T.pack $ clientErrorMessage e
-      return Nothing
     Right c -> return $ Just c
 
 --------------------------------------------------------------------------------
@@ -105,14 +90,12 @@ getDBusClient_ sys = do
 
 type MethodBody = Either T.Text [Variant]
 
-callMethod' :: (MonadIO m, SafeClient c) => c -> MethodCall -> m MethodBody
+callMethod' :: SafeClient c => c -> MethodCall -> IO MethodBody
-callMethod' cl =
+callMethod' cl = fmap (bimap (T.pack . methodErrorMessage) methodReturnBody)
-  liftIO
-  . fmap (bimap (T.pack . methodErrorMessage) methodReturnBody)
   . call (toClient cl)
 
-callMethod :: (MonadIO m, SafeClient c) => c -> BusName -> ObjectPath -> InterfaceName
+callMethod :: SafeClient c => c -> BusName -> ObjectPath -> InterfaceName
-  -> MemberName -> m MethodBody
+  -> MemberName -> IO MethodBody
 callMethod client bus path iface = callMethod' client . methodCallBus bus path iface
 
 methodCallBus :: BusName -> ObjectPath -> InterfaceName -> MemberName -> MethodCall
@@ -125,7 +108,7 @@ methodCallBus b p i m = (methodCall p i m)
 dbusInterface :: InterfaceName
 dbusInterface = interfaceName_ "org.freedesktop.DBus"
 
-callGetNameOwner :: (MonadIO 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 = (methodCallBus dbusName dbusPath dbusInterface mem)
@@ -146,14 +129,9 @@ bodyToMaybe = either (const Nothing) fromSingletonVariant
 
 type SignalCallback = [Variant] -> IO ()
 
-addMatchCallback
+addMatchCallback :: SafeClient c => MatchRule -> SignalCallback -> c
-  :: (MonadIO m, SafeClient c)
+  -> IO SignalHandler
-  => MatchRule
+addMatchCallback rule cb cl = addMatch (toClient cl) rule $ cb . signalBody
-  -> SignalCallback
-  -> c
-  -> m SignalHandler
-addMatchCallback rule cb cl =
-  liftIO $ addMatch (toClient cl) rule $ cb . signalBody
 
 matchSignal :: Maybe BusName -> Maybe ObjectPath -> Maybe InterfaceName
   -> Maybe MemberName -> MatchRule
@@ -164,14 +142,8 @@ matchSignal b p i m = matchAny
   , matchMember = m
   }
 
-matchSignalFull
+matchSignalFull :: SafeClient c => c -> BusName -> Maybe ObjectPath
-  :: (MonadIO m, SafeClient c)
+  -> Maybe InterfaceName -> Maybe MemberName -> IO (Maybe MatchRule)
-  => c
-  -> BusName
-  -> Maybe ObjectPath
-  -> Maybe InterfaceName
-  -> Maybe MemberName
-  -> m (Maybe MatchRule)
 matchSignalFull client b p i m =
   fmap (\o -> matchSignal (Just o) p i m) <$> callGetNameOwner client b
 
@@ -184,29 +156,23 @@ propertyInterface = interfaceName_ "org.freedesktop.DBus.Properties"
 propertySignal :: MemberName
 propertySignal = memberName_ "PropertiesChanged"
 
-callPropertyGet :: (MonadIO m, SafeClient c) => BusName -> ObjectPath -> InterfaceName
+callPropertyGet :: SafeClient c => BusName -> ObjectPath -> InterfaceName
-  -> MemberName -> c -> m [Variant]
+  -> MemberName -> c -> IO [Variant]
-callPropertyGet bus path iface property cl =
+callPropertyGet bus path iface property cl = fmap (either (const []) (:[]))
-  liftIO
-  $ fmap (either (const []) (:[]))
   $ getProperty (toClient cl) $ methodCallBus bus path iface property
 
 matchProperty :: Maybe BusName -> Maybe ObjectPath -> MatchRule
 matchProperty b p =
   matchSignal b p (Just propertyInterface) (Just propertySignal)
 
-matchPropertyFull
+matchPropertyFull :: SafeClient c => c -> BusName -> Maybe ObjectPath
-  :: (MonadIO m, SafeClient c)
+  -> IO (Maybe MatchRule)
-  => c
-  -> BusName
-  -> Maybe ObjectPath
-  -> m (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 :: Monad 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 ()
@@ -242,44 +208,24 @@ omInterfacesAdded = memberName_ "InterfacesAdded"
 omInterfacesRemoved :: MemberName
 omInterfacesRemoved = memberName_ "InterfacesRemoved"
 
-callGetManagedObjects
+callGetManagedObjects :: SafeClient c => c -> BusName -> ObjectPath
-  :: (MonadIO m, SafeClient c)
+  -> IO ObjectTree
-  => c
-  -> BusName
-  -> ObjectPath
-  -> m ObjectTree
 callGetManagedObjects cl bus path =
   either (const M.empty) (fromMaybe M.empty . fromSingletonVariant)
   <$> callMethod cl bus path omInterface getManagedObjects
 
-addInterfaceChangedListener
+addInterfaceChangedListener :: SafeClient c => BusName -> MemberName
-  :: (MonadIO m, SafeClient c)
+  -> ObjectPath -> SignalCallback -> c -> IO (Maybe SignalHandler)
-  => BusName
-  -> MemberName
-  -> ObjectPath
-  -> SignalCallback
-  -> c
-  -> m (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
+addInterfaceAddedListener :: SafeClient c => BusName -> ObjectPath
-  :: (MonadIO m, SafeClient c)
+  -> SignalCallback -> c -> IO (Maybe SignalHandler)
-  => BusName
-  -> ObjectPath
-  -> SignalCallback
-  -> c
-  -> m (Maybe SignalHandler)
 addInterfaceAddedListener bus =
   addInterfaceChangedListener bus omInterfacesAdded
 
-addInterfaceRemovedListener
+addInterfaceRemovedListener :: SafeClient c => BusName -> ObjectPath
-  :: (MonadIO m, SafeClient c)
+  -> SignalCallback -> c -> IO (Maybe SignalHandler)
-  => BusName
-  -> ObjectPath
-  -> SignalCallback
-  -> c
-  -> m (Maybe SignalHandler)
 addInterfaceRemovedListener bus =
   addInterfaceChangedListener bus omInterfacesRemoved

lib/Data/Internal/Dependency.hs

@@ -106,9 +106,17 @@ module Data.Internal.Dependency
   , shellTest
   ) where
 
+import           Control.Monad.IO.Class
+import           Control.Monad.Identity
+import           Control.Monad.Reader
+
 import           Data.Aeson             hiding (Error, Result)
 import           Data.Aeson.Key
+import           Data.Bifunctor
+import           Data.Either
 import           Data.Internal.DBus
+import           Data.List
+import           Data.Maybe
 import           Data.Yaml
 
 import           GHC.IO.Exception       (ioe_description)
@@ -117,12 +125,11 @@ import           DBus                  hiding (typeOf)
 import qualified DBus.Introspection     as I
 
 import           RIO                    hiding (bracket, fromString)
-import           RIO.Directory
 import           RIO.FilePath
-import           RIO.List
 import           RIO.Process            hiding (findExecutable)
 import qualified RIO.Text               as T
 
+import           System.Directory
 import           System.Environment
 import           System.IO.Error
 import           System.Posix.Files

lib/XMonad/Internal/Command/DMenu.hs

@@ -24,9 +24,12 @@ import           DBus
 
 import           Graphics.X11.Types
 
-import           RIO.Directory
 import qualified RIO.Text                        as T
 
+import           System.Directory
+    ( XdgDirectory (..)
+    , getXdgDirectory
+    )
 import           System.IO
 
 import           XMonad.Core                     hiding (spawn)

lib/XMonad/Internal/Command/Desktop.hs

@@ -47,11 +47,11 @@ import           Data.Internal.Dependency
 import           DBus
 
 import           RIO
-import           RIO.Directory
 import           RIO.FilePath
 import qualified RIO.Process                 as P
 import qualified RIO.Text                    as T
 
+import           System.Directory
 import           System.Environment
 import           System.Posix.User
 

lib/XMonad/Internal/Command/Power.hs

@@ -29,15 +29,17 @@ module XMonad.Internal.Command.Power
 
 import           Data.Internal.Dependency
 
+import           Data.Either
+import qualified Data.Map                    as M
+
 import           Graphics.X11.Types
 
 import           RIO
-import           RIO.Directory
 import           RIO.FilePath
-import qualified RIO.Map                     as M
 import qualified RIO.Process                 as P
 import qualified RIO.Text                    as T
 
+import           System.Directory
 import           System.IO.Error
 
 import           XMonad.Core                 hiding (spawn)

lib/XMonad/Internal/Concurrent/ClientMessage.hs

@@ -19,7 +19,6 @@ module XMonad.Internal.Concurrent.ClientMessage
   ( XMsgType(..)
   , sendXMsg
   , splitXMsg
-  , withOpenDisplay
   ) where
 
 import           Data.Char

lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs

@@ -33,7 +33,17 @@ module XMonad.Internal.Concurrent.DynamicWorkspaces
   , doSink
   ) where
 
+import           Data.List                                (deleteBy, find)
+import qualified Data.Map                                 as M
+import           Data.Maybe
+
+-- import           Control.Concurrent
+import           Control.Monad
+import           Control.Monad.Reader
+
+
 import           Graphics.X11.Types
+
 import           Graphics.X11.Xlib.Atom
 import           Graphics.X11.Xlib.Display
 import           Graphics.X11.Xlib.Event
@@ -45,8 +55,6 @@ import           RIO                                      hiding
     ( Display
     , display
     )
-import           RIO.List
-import qualified RIO.Map                                  as M
 import qualified RIO.Set                                  as S
 
 import           System.Process
@@ -98,6 +106,9 @@ data WConf = WConf
 
 type W a = RIO WConf ()
 
+withOpenDisplay :: (Display -> IO a) -> IO a
+withOpenDisplay = bracket (openDisplay "") closeDisplay
+
 runWorkspaceMon :: [DynWorkspace] -> IO ()
 runWorkspaceMon dws = withOpenDisplay $ \dpy -> do
   root <- rootWindow dpy $ defaultScreen dpy

lib/XMonad/Internal/Concurrent/VirtualBox.hs

@@ -12,13 +12,13 @@ module XMonad.Internal.Concurrent.VirtualBox
 
 import           Data.Internal.Dependency
 
+import           Text.XML.Light
+
 import           RIO                      hiding (try)
 import           RIO.Directory
 import           RIO.FilePath
 import qualified RIO.Text                 as T
 
-import           Text.XML.Light
-
 import           XMonad.Internal.Shell
 
 vmExists :: T.Text -> IO (Maybe Msg)

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

@@ -12,12 +12,14 @@ module XMonad.Internal.DBus.Brightness.ClevoKeyboard
   , blPath
   ) where
 
+import           Control.Monad                          (when)
+
+import           Data.Int                               (Int32)
 import           Data.Internal.DBus
 import           Data.Internal.Dependency
 
 import           DBus
 
-import           RIO
 import           RIO.FilePath
 
 import           XMonad.Internal.DBus.Brightness.Common

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

@@ -13,6 +13,9 @@ module XMonad.Internal.DBus.Brightness.Common
   , signalDep
   ) where
 
+import           Control.Monad               (void)
+
+import           Data.Int                    (Int32)
 import           Data.Internal.DBus
 import           Data.Internal.Dependency
 
@@ -20,7 +23,6 @@ import           DBus
 import           DBus.Client
 import qualified DBus.Introspection          as I
 
-import           RIO
 import qualified RIO.Text                    as T
 
 import           XMonad.Core                 (io)

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

@@ -12,12 +12,12 @@ module XMonad.Internal.DBus.Brightness.IntelBacklight
   , blPath
   ) where
 
+import           Data.Int                               (Int32)
 import           Data.Internal.DBus
 import           Data.Internal.Dependency
 
 import           DBus
 
-import           RIO
 import           RIO.FilePath
 
 import           XMonad.Internal.DBus.Brightness.Common

lib/XMonad/Internal/DBus/Control.hs

@@ -1,8 +1,8 @@
--- | High-level interface for managing XMonad's DBus
-
-{-# LANGUAGE OverloadedStrings   #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
+--------------------------------------------------------------------------------
+-- | High-level interface for managing XMonad's DBus
+
 module XMonad.Internal.DBus.Control
   ( Client
   , DBusState(..)
@@ -17,15 +17,14 @@ module XMonad.Internal.DBus.Control
   , dbusExporters
   ) where
 
+import           Control.Monad
+
 import           Data.Internal.DBus
 import           Data.Internal.Dependency
 
 import           DBus
 import           DBus.Client
 
-import           RIO
-import qualified RIO.Text                                       as T
-
 import           XMonad.Internal.DBus.Brightness.ClevoKeyboard
 import           XMonad.Internal.DBus.Brightness.IntelBacklight
 import           XMonad.Internal.DBus.Common
@@ -38,36 +37,27 @@ data DBusState = DBusState
     }
 
 -- | Connect to the DBus
-connectDBus
+connectDBus :: IO DBusState
-  :: (MonadUnliftIO m, MonadReader env m, HasLogFunc env)
-  => m DBusState
 connectDBus = do
   ses <- getDBusClient
   sys <- getDBusClient
   return DBusState { dbSesClient = ses, dbSysClient = sys }
 
 -- | Disconnect from the DBus
-disconnectDBus
+disconnectDBus :: DBusState -> IO ()
-  :: (MonadUnliftIO m)
-  => DBusState -> m ()
 disconnectDBus db = disc dbSesClient >> disc dbSysClient
   where
     disc f = maybe (return ()) disconnectDBusClient $ f db
 
 -- | Connect to the DBus and request the XMonad name
-connectDBusX
+connectDBusX :: IO DBusState
-  :: (MonadUnliftIO m, MonadReader env m, HasLogFunc env)
-  => m DBusState
 connectDBusX = do
   db <- connectDBus
   forM_ (dbSesClient db) requestXMonadName
   return db
 
 -- | Disconnect from DBus and release the XMonad name
-disconnectDBusX
+disconnectDBusX :: DBusState -> IO ()
-  :: (MonadUnliftIO m)
-  => DBusState
-  -> m ()
 disconnectDBusX db = do
   forM_ (dbSesClient db) releaseXMonadName
   disconnectDBus db
@@ -76,25 +66,18 @@ disconnectDBusX db = do
 dbusExporters :: [Maybe SesClient -> SometimesIO]
 dbusExporters = [exportScreensaver, exportIntelBacklight, exportClevoKeyboard]
 
-releaseXMonadName
+releaseXMonadName :: SesClient -> IO ()
-  :: (MonadUnliftIO m)
+releaseXMonadName ses = void $ releaseName (toClient ses) xmonadBusName
-  => SesClient
-  -> m ()
-releaseXMonadName ses = void $ liftIO $ releaseName (toClient ses) xmonadBusName
 
-requestXMonadName
+requestXMonadName :: SesClient -> IO ()
-  :: (MonadUnliftIO m, MonadReader env m, HasLogFunc env)
-  => SesClient
-  -> m ()
 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
-          | res == NameAlreadyOwner = Just "this process already owns bus name"
+          | res == NameAlreadyOwner = Just $ "this process already owns " ++ xn
           | res == NameInQueue
-            || res == NameExists = Just "another process owns bus name"
+            || res == NameExists = Just $ "another process owns " ++ xn
-          | otherwise = Just "unknown error when requesting bus name"
+          | otherwise = Just $ "unknown error when requesting " ++ xn
-  forM_ msg $ \m ->
+  forM_ msg putStrLn
-    logError $ Utf8Builder $ encodeUtf8Builder $ T.concat [m, ": ", xn]
   where
-    xn = T.pack $ formatBusName xmonadBusName
+    xn = "'" ++ formatBusName xmonadBusName ++ "'"

lib/XMonad/Internal/DBus/Removable.hs

@@ -8,15 +8,15 @@
 
 module XMonad.Internal.DBus.Removable (runRemovableMon) where
 
+import           Control.Monad
+
 import           Data.Internal.DBus
 import           Data.Internal.Dependency
+import           Data.Map.Strict                 (Map, member)
 
 import           DBus
 import           DBus.Client
 
-import           RIO
-import qualified RIO.Map                         as M
-
 import           XMonad.Core                     (io)
 import           XMonad.Internal.Command.Desktop
 
@@ -60,7 +60,7 @@ driveFlag :: String
 driveFlag = "org.freedesktop.UDisks2.Drive"
 
 addedHasDrive :: [Variant] -> Bool
-addedHasDrive [_, a] = maybe False (M.member driveFlag)
+addedHasDrive [_, a] = maybe False (member driveFlag)
   (fromVariant a :: Maybe (Map String (Map String Variant)))
 addedHasDrive _ = False
 

lib/XMonad/Internal/DBus/Screensaver.hs

@@ -14,15 +14,15 @@ module XMonad.Internal.DBus.Screensaver
 import           Data.Internal.DBus
 import           Data.Internal.Dependency
 
+import           RIO
+
 import           DBus
 import           DBus.Client
 import qualified DBus.Introspection          as I
 
 import           Graphics.X11.XScreenSaver
+import           Graphics.X11.Xlib.Display
 
-import           RIO
-
-import           XMonad.Internal.Concurrent.ClientMessage
 import           XMonad.Internal.DBus.Common
 import           XMonad.Internal.Shell
 
@@ -45,7 +45,10 @@ toggle = do
 
 query :: IO SSState
 query = do
-  xssi <- withOpenDisplay xScreenSaverQueryInfo
+  -- TODO bracket the display
+  dpy <- openDisplay ""
+  xssi <- xScreenSaverQueryInfo dpy
+  closeDisplay dpy
   return $ case xssi of
     Just XScreenSaverInfo { xssi_state = ScreenSaverDisabled } -> False
     Just XScreenSaverInfo { xssi_state = _ }                   -> True

lib/XMonad/Internal/IO.hs

@@ -25,11 +25,12 @@ module XMonad.Internal.IO
   ) where
 
 import           Data.Char
+import           Data.Text       (pack, unpack)
+import           Data.Text.IO    as T (readFile, writeFile)
 
 import           RIO
 import           RIO.Directory
 import           RIO.FilePath
-import qualified RIO.Text        as T
 
 import           System.IO.Error
 
@@ -37,7 +38,7 @@ import           System.IO.Error
 -- | read
 
 readInt :: (Read a, Integral a) => FilePath -> IO a
-readInt = fmap (read . T.unpack . T.takeWhile isDigit) . readFileUtf8
+readInt = fmap (read . takeWhile isDigit . unpack) . T.readFile
 
 readBool :: FilePath -> IO Bool
 readBool = fmap (==(1 :: Int)) . readInt
@@ -46,7 +47,7 @@ readBool = fmap (==(1 :: Int)) . readInt
 -- | write
 
 writeInt :: (Show a, Integral a) => FilePath -> a -> IO ()
-writeInt f = writeFileUtf8 f . T.pack . show
+writeInt f = T.writeFile f . pack . show
 
 writeBool :: FilePath -> Bool -> IO ()
 writeBool f b = writeInt f ((if b then 1 else 0) :: Int)

lib/XMonad/Internal/Process.hs

@@ -0,0 +1,17 @@
+--------------------------------------------------------------------------------
+-- | Functions for managing processes
+
+module XMonad.Internal.Process where
+
+-- import           Control.Exception
+-- import           Control.Monad
+-- import           Control.Monad.IO.Class
+
+-- import qualified RIO.Text               as T
+
+-- import           System.Exit
+-- import           System.IO
+-- import           System.Process
+
+-- import           XMonad.Core            hiding (spawn)
+

lib/Xmobar/Plugins/BacklightCommon.hs

@@ -10,7 +10,6 @@ module Xmobar.Plugins.BacklightCommon (startBacklight) where
 
 import           Data.Internal.DBus
 
-import           RIO
 import qualified RIO.Text              as T
 
 import           Xmobar.Plugins.Common
@@ -18,9 +17,9 @@ import           Xmobar.Plugins.Common
 startBacklight :: RealFrac a => ((Maybe a -> IO ()) -> SesClient -> IO ())
   -> (SesClient -> IO (Maybe a)) -> T.Text -> Callback -> IO ()
 startBacklight matchSignal callGetBrightness icon cb = do
-    withDBusClientConnection cb $ \c -> liftIO $ 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

@@ -38,16 +38,19 @@ module Xmobar.Plugins.Bluetooth
   , btDep
   ) where
 
+import           Control.Concurrent.MVar
+import           Control.Monad
+
 import           Data.Internal.DBus
 import           Data.Internal.Dependency
+import           Data.List
 import           Data.List.Split
+import qualified Data.Map                    as M
+import           Data.Maybe
 
 import           DBus
 import           DBus.Client
 
-import           RIO
-import           RIO.List
-import qualified RIO.Map                     as M
 import qualified RIO.Text                    as T
 
 import           XMonad.Internal.DBus.Common
@@ -68,24 +71,23 @@ instance Exec Bluetooth where
   start (Bluetooth icons colors) cb =
     withDBusClientConnection cb $ startAdapter icons colors cb
 
-startAdapter :: MonadIO m => Icons -> Colors -> Callback -> SysClient -> m ()
+startAdapter :: Icons -> Colors -> Callback -> SysClient -> IO ()
 startAdapter is cs cb cl = do
   ot <- getBtObjectTree cl
-  -- TODO use RIO for this?
   state <- newMVar emptyState
-  let dpy = displayIcon cb (iconFormatter is cs) state
+  let display = displayIcon cb (iconFormatter is cs) state
-  forM_ (findAdapter ot) $ \adapter -> liftIO $ do
+  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
@@ -97,9 +99,9 @@ type IconFormatter = (Maybe Bool -> Bool -> T.Text)
 
 type Icons = (T.Text, T.Text)
 
-displayIcon :: MonadIO 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
@@ -136,7 +138,7 @@ emptyState = BtState
   , btPowered = Nothing
   }
 
-readState :: MonadIO m => MutableBtState -> m (Maybe Bool, Bool)
+readState :: MutableBtState -> IO (Maybe Bool, Bool)
 readState state = do
   p <- readPowered state
   c <- readDevices state
@@ -159,55 +161,55 @@ adaptorHasDevice adaptor device = case splitPath device of
 splitPath :: ObjectPath -> [T.Text]
 splitPath = fmap T.pack . splitOn "/" . dropWhile (=='/') . formatObjectPath
 
-getBtObjectTree :: MonadIO m => SysClient -> m ObjectTree
+getBtObjectTree :: SysClient -> IO ObjectTree
 getBtObjectTree sys = callGetManagedObjects sys btBus btOMPath
 
 btOMPath :: ObjectPath
 btOMPath = objectPath_ "/"
 
-addBtOMListener :: MonadIO m => SignalCallback -> SysClient -> m ()
+addBtOMListener :: SignalCallback -> SysClient -> IO ()
-addBtOMListener sc = liftIO . void . addInterfaceAddedListener btBus btOMPath sc
+addBtOMListener sc = void . addInterfaceAddedListener btBus btOMPath sc
 
-addDeviceAddedListener :: MonadIO m => MutableBtState -> IO () -> ObjectPath -> SysClient -> m ()
+addDeviceAddedListener :: MutableBtState -> IO () -> ObjectPath -> SysClient -> IO ()
-addDeviceAddedListener state dpy adapter client =
+addDeviceAddedListener state display 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 :: MonadIO m => MutableBtState -> IO () -> ObjectPath -> SysClient -> m ()
+addDeviceRemovedListener :: MutableBtState -> IO () -> ObjectPath -> SysClient -> IO ()
-addDeviceRemovedListener state dpy adapter sys =
+addDeviceRemovedListener state display adapter sys =
   addBtOMListener remDevice sys
   where
-    remDevice = pathCallback adapter dpy $ \d -> do
+    remDevice = pathCallback adapter display $ \d -> do
       old <- removeDevice state d
       forM_ old $ removeMatch (toClient sys) . btDevSigHandler
 
 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 :: MonadIO m => MutableBtState -> ObjectPath -> SysClient -> m ()
+initAdapter :: MutableBtState -> ObjectPath -> SysClient -> IO ()
 initAdapter state adapter client = do
   reply <- callGetPowered adapter client
-  liftIO $ putPowered state $ fromSingletonVariant reply
+  putPowered state $ fromSingletonVariant reply
 
-matchBTProperty :: MonadIO m => SysClient -> ObjectPath -> m (Maybe MatchRule)
+matchBTProperty :: SysClient -> ObjectPath -> IO (Maybe MatchRule)
 matchBTProperty sys p = matchPropertyFull sys btBus (Just p)
 
-addAdaptorListener :: MonadIO m => MutableBtState -> IO () -> ObjectPath -> SysClient
+addAdaptorListener :: MutableBtState -> IO () -> 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 -> liftIO $ putPowered state b >> dpy
+    procMatch = withSignalMatch $ \b -> putPowered state b >> display
 
-callGetPowered :: MonadIO m => ObjectPath -> SysClient -> m [Variant]
+callGetPowered :: ObjectPath -> SysClient -> IO [Variant]
 callGetPowered adapter = callPropertyGet btBus adapter adapterInterface
   $ memberName_ $ T.unpack adaptorPowered
 
@@ -217,7 +219,7 @@ matchPowered = matchPropertyChanged adapterInterface adaptorPowered
 putPowered :: MutableBtState -> Maybe Bool -> IO ()
 putPowered m ds = modifyMVar_ m (\s -> return s { btPowered = ds })
 
-readPowered :: MonadIO m => MutableBtState -> m (Maybe Bool)
+readPowered :: MutableBtState -> IO (Maybe Bool)
 readPowered = fmap btPowered . readMVar
 
 adapterInterface :: InterfaceName
@@ -229,13 +231,13 @@ adaptorPowered = "Powered"
 --------------------------------------------------------------------------------
 -- | Devices
 
-addAndInitDevice :: MonadUnliftIO m => MutableBtState -> IO () -> ObjectPath -> SysClient -> m ()
+addAndInitDevice :: MutableBtState -> IO () -> ObjectPath -> SysClient -> IO ()
-addAndInitDevice state dpy device client = do
+addAndInitDevice state display device client = do
-  sh <- addDeviceListener state dpy device client
+  sh <- addDeviceListener state display device client
   -- TODO add some intelligent error messages here
   forM_ sh $ \s -> initDevice state s device client
 
-initDevice :: MonadUnliftIO m => MutableBtState -> SignalHandler -> ObjectPath -> SysClient -> m ()
+initDevice :: MutableBtState -> SignalHandler -> ObjectPath -> SysClient -> IO ()
 initDevice state sh device sys = do
   reply <- callGetConnected device sys
   void $ insertDevice state device $
@@ -243,22 +245,22 @@ initDevice state sh device sys = do
              , btDevSigHandler = sh
              }
 
-addDeviceListener :: MonadIO m => MutableBtState -> IO () -> ObjectPath -> SysClient
+addDeviceListener :: MutableBtState -> IO () -> 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 :: MonadIO m => ObjectPath -> SysClient -> m [Variant]
+callGetConnected :: ObjectPath -> SysClient -> IO [Variant]
 callGetConnected p = callPropertyGet btBus p devInterface
   $ memberName_ (T.unpack devConnected)
 
-insertDevice :: MonadUnliftIO m => MutableBtState -> ObjectPath -> BTDevice -> m Bool
+insertDevice :: MutableBtState -> ObjectPath -> BTDevice -> IO Bool
 insertDevice m device dev = modifyMVar m $ \s -> do
   let new = M.insert device dev $ btDevices s
   return (s { btDevices = new }, anyDevicesConnected new)
@@ -276,7 +278,7 @@ removeDevice m device = modifyMVar m $ \s -> do
   let devs = btDevices s
   return (s { btDevices = M.delete device devs }, M.lookup device devs)
 
-readDevices :: MonadIO m => MutableBtState -> m ConnectedDevices
+readDevices :: MutableBtState -> IO ConnectedDevices
 readDevices = fmap btDevices . readMVar
 
 devInterface :: InterfaceName

lib/Xmobar/Plugins/ClevoKeyboard.hs

@@ -14,6 +14,7 @@ module Xmobar.Plugins.ClevoKeyboard
 import qualified RIO.Text                                      as T
 
 import           Xmobar
+
 import           Xmobar.Plugins.BacklightCommon
 
 import           XMonad.Internal.DBus.Brightness.ClevoKeyboard

lib/Xmobar/Plugins/Common.hs

@@ -10,17 +10,18 @@ module Xmobar.Plugins.Common
   , Callback
   , Colors(..)
   , displayMaybe
-  , displayMaybe_
+  , displayMaybe'
   , xmobarFGColor
   )
   where
 
+import           Control.Monad
+
 import           Data.Internal.DBus
 
 import           DBus
 import           DBus.Client
 
-import           RIO
 import qualified RIO.Text                as T
 
 import           XMonad.Hooks.DynamicLog (xmobarColor)
@@ -34,21 +35,17 @@ data Colors = Colors
   }
   deriving (Eq, Show, Read)
 
-startListener :: (MonadIO m, SafeClient c, IsVariant a) => MatchRule -> (c -> m [Variant])
+startListener :: (SafeClient c, IsVariant a) => MatchRule -> (c -> IO [Variant])
   -> ([Variant] -> SignalMatch a) -> (a -> IO T.Text) -> Callback
-  -> c -> m ()
+  -> c -> IO ()
 startListener rule getProp fromSignal toColor cb client = do
   reply <- getProp client
-  displayMaybe cb (liftIO . toColor) $ fromSingletonVariant reply
+  displayMaybe cb toColor $ fromSingletonVariant reply
   void $ addMatchCallback rule (procMatch . fromSignal) client
   where
     procMatch = procSignalMatch cb toColor
 
-procSignalMatch
+procSignalMatch :: Callback -> (a -> IO T.Text) -> SignalMatch a -> IO ()
-  :: Callback
-  -> (a -> IO T.Text)
-  -> SignalMatch a
-  -> IO ()
 procSignalMatch cb f = withSignalMatch (displayMaybe cb f)
 
 colorText :: Colors -> Bool -> T.Text -> T.Text
@@ -61,17 +58,11 @@ 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 :: 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_ :: MonadIO 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 ()
-  :: (SafeClient c)
+withDBusClientConnection cb f = displayMaybe' cb f =<< getDBusClient
-  => Callback
-  -> (c -> RIO SimpleApp ())
-  -> IO ()
-withDBusClientConnection cb f = do
-  -- TODO be more sophisticated
-  runSimpleApp $ withDBusClient_ $ displayMaybe_ cb f . Just

lib/Xmobar/Plugins/Device.hs

@@ -11,12 +11,14 @@ module Xmobar.Plugins.Device
   , devDep
   ) where
 
+import           Control.Monad
+
 import           Data.Internal.DBus
 import           Data.Internal.Dependency
+import           Data.Word
 
 import           DBus
 
-import           RIO
 import qualified RIO.Text                        as T
 
 import           XMonad.Internal.Command.Desktop
@@ -62,9 +64,9 @@ matchStatus = matchPropertyChanged nmDeviceInterface devSignal
 instance Exec Device where
   alias (Device (iface, _, _)) = T.unpack iface
   start (Device (iface, text, colors)) cb = do
-    withDBusClientConnection cb $ \sys -> liftIO $ do
+    withDBusClientConnection cb $ \sys -> do
       path <- getDevice sys iface
-      displayMaybe_ cb (listener sys) path
+      displayMaybe' cb (listener sys) path
     where
       listener sys path = do
         rule <- matchPropertyFull sys networkManagerBus (Just path)

lib/Xmobar/Plugins/IntelBacklight.hs

@@ -14,6 +14,7 @@ module Xmobar.Plugins.IntelBacklight
 import qualified RIO.Text                                       as T
 
 import           Xmobar
+
 import           Xmobar.Plugins.BacklightCommon
 
 import           XMonad.Internal.DBus.Brightness.IntelBacklight

lib/Xmobar/Plugins/Screensaver.hs

@@ -11,7 +11,6 @@ module Xmobar.Plugins.Screensaver
   , ssAlias
   ) where
 
-import           RIO
 import qualified RIO.Text                         as T
 
 import           Xmobar
@@ -27,9 +26,9 @@ ssAlias = "screensaver"
 instance Exec Screensaver where
   alias (Screensaver _) = T.unpack ssAlias
   start (Screensaver (text, colors)) cb = do
-    withDBusClientConnection cb $ \sys -> liftIO $ do
+    withDBusClientConnection cb $ \sys -> do
-      matchSignal dpy sys
+      matchSignal display sys
-      dpy =<< callQuery sys
+      display =<< callQuery sys
     where
-      dpy = displayMaybe cb $ return . (\s -> colorText colors s text)
+      display = displayMaybe cb $ return . (\s -> colorText colors s text)
 

lib/Xmobar/Plugins/VPN.hs

@@ -13,15 +13,17 @@ module Xmobar.Plugins.VPN
   , vpnDep
   ) where
 
+import           Control.Concurrent.MVar
+import           Control.Monad
 
 import           Data.Internal.DBus
 import           Data.Internal.Dependency
+import qualified Data.Map                        as M
+import           Data.Maybe
+import qualified Data.Set                        as S
 
 import           DBus
 
-import           RIO
-import qualified RIO.Map                         as M
-import qualified RIO.Set                         as S
 import qualified RIO.Text                        as T
 
 import           XMonad.Internal.Command.Desktop
@@ -36,11 +38,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
-    liftIO dpy
+    display
     where
       iconFormatter b = return $ colorText colors b text
 
@@ -55,7 +57,7 @@ type VPNState = S.Set ObjectPath
 
 type MutableVPNState = MVar VPNState
 
-initState :: MonadIO m => SysClient -> m MutableVPNState
+initState :: SysClient -> IO MutableVPNState
 initState client = do
   ot <- getVPNObjectTree client
   newMVar $ findTunnels ot
@@ -63,28 +65,28 @@ initState client = do
 readState :: MutableVPNState -> IO Bool
 readState = fmap (not . null) . readMVar
 
-updateState :: MonadUnliftIO m => (ObjectPath -> VPNState -> VPNState) -> MutableVPNState
+updateState :: (ObjectPath -> VPNState -> VPNState) -> MutableVPNState
-  -> ObjectPath -> m ()
+  -> ObjectPath -> IO ()
 updateState f state op = modifyMVar_ state $ return . f op
 
 --------------------------------------------------------------------------------
 -- | Tunnel Device Detection
 --
 
-getVPNObjectTree :: MonadIO 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 :: MonadIO m => SignalCallback -> SysClient -> m ()
+vpnAddedListener :: SignalCallback -> SysClient -> IO ()
 vpnAddedListener cb = void . addInterfaceAddedListener vpnBus vpnPath cb
 
-vpnRemovedListener :: MonadIO m => SignalCallback -> SysClient -> m ()
+vpnRemovedListener :: SignalCallback -> SysClient -> IO ()
 vpnRemovedListener cb = void . addInterfaceRemovedListener vpnBus vpnPath cb
 
 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'
@@ -92,7 +94,7 @@ addedCallback state dpy [device, added] = update >> dpy
 addedCallback _ _ _                       = return ()
 
 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