ENH generalize dep IO functions

lib/Data/Internal/Dependency.hs

@@ -114,14 +114,13 @@ import Data.Maybe
 import Data.Yaml
 import GHC.IO.Exception (ioe_description)
 import RIO hiding (bracket, fromString)
+import RIO.Directory
 import RIO.FilePath
 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
 import System.Process.Typed (nullStream)
+import UnliftIO.Environment
 import XMonad.Core (X, io)
 import XMonad.Internal.IO
 import XMonad.Internal.Shell hiding (proc, runProcess)
@@ -484,16 +483,16 @@ defXPFeatures =
 
 type XPQuery = XPFeatures -> Bool
 
-getParams :: IO XParams
+getParams :: MonadIO m => m XParams
 getParams = do
   p <- getParamFile
-  maybe (return defParams) decodeYaml p
+  maybe (return defParams) (liftIO . decodeYaml) p
   where
     decodeYaml p =
       either (\e -> print e >> return defParams) return
         =<< decodeFileEither p
 
-getParamFile :: IO (Maybe FilePath)
+getParamFile :: MonadIO m => m (Maybe FilePath)
 getParamFile = do
   e <- lookupEnv "XDG_CONFIG_HOME"
   parent <- case e of
@@ -502,7 +501,7 @@ getParamFile = do
       | isRelative path -> fallback
       | otherwise -> return path
   let full = parent </> "xmonad.yml"
-  (\x -> if x then Just full else Nothing) <$> fileExist full
+  (\x -> if x then Just full else Nothing) <$> doesFileExist full
   where
     fallback = (</> ".config") <$> getHomeDirectory
 
@@ -682,9 +681,12 @@ testIODepNoCache_ (IOSometimes_ x) =
     <$> evalSometimesMsg x
 
 --------------------------------------------------------------------------------
+-- System Dependency Testing
 
--- | System Dependency Testing
+testSysDependency
-testSysDependency :: SystemDependency -> FIO (Maybe Msg)
+  :: (MonadUnliftIO m, MonadReader env m, HasProcessContext env, HasLogFunc env)
+  => SystemDependency
+  -> m (Maybe Msg)
 testSysDependency (Executable sys bin) =
   io $
     maybe (Just msg) (const Nothing)
@@ -713,7 +715,12 @@ testSysDependency (AccessiblePath p r w) = io $ permMsg <$> getPermissionsSafe p
         (_, Just False) -> mkErr "file not writable"
         _ -> Nothing
 
-shellTest :: FilePath -> [T.Text] -> T.Text -> FIO (Maybe Msg)
+shellTest
+  :: (MonadReader env m, HasProcessContext env, HasLogFunc env, MonadUnliftIO m)
+  => FilePath
+  -> [T.Text]
+  -> T.Text
+  -> m (Maybe Msg)
 shellTest cmd args msg = do
   rc <- proc cmd (T.unpack <$> args) (runProcess . setStdout nullStream)
   return $ case rc of
@@ -764,7 +771,10 @@ fontTestName fam = T.unwords ["test if font", singleQuote fam, "exists"]
 -- testFont :: T.Text -> FIO (Result FontBuilder)
 -- testFont = liftIO . testFont'
 
-testFont :: T.Text -> FIO (Result FontBuilder)
+testFont
+  :: (MonadUnliftIO m, MonadReader env m, HasProcessContext env, HasLogFunc env)
+  => T.Text
+  -> m (Result FontBuilder)
 testFont fam = maybe pass (Left . (: [])) <$> shellTest "fc-list" args msg
   where
     msg = T.unwords ["font family", qFam, "not found"]
@@ -790,10 +800,10 @@ isWireless = T.isPrefixOf "wl"
 isEthernet :: T.Text -> Bool
 isEthernet = T.isPrefixOf "en"
 
-listInterfaces :: IO [T.Text]
+listInterfaces :: MonadUnliftIO m => m [T.Text]
 listInterfaces =
   fromRight []
-    <$> tryIOError (fmap T.pack <$> listDirectory sysfsNet)
+    <$> tryIO (fmap T.pack <$> listDirectory sysfsNet)
 
 sysfsNet :: FilePath
 sysfsNet = "/sys/class/net"
@@ -816,19 +826,18 @@ readInterface n f = IORead n [] go
 --------------------------------------------------------------------------------
 -- Misc testers
 
-socketExists :: T.Text -> [Fulfillment] -> IO FilePath -> IODependency_
+socketExists :: T.Text -> [Fulfillment] -> FIO FilePath -> IODependency_
 socketExists n ful =
-  IOTest_ (T.unwords ["test if", n, "socket exists"]) ful
+  IOTest_ (T.unwords ["test if", n, "socket exists"]) ful . socketExists'
-    . io
-    . socketExists'
 
-socketExists' :: IO FilePath -> IO (Maybe Msg)
+socketExists' :: MonadUnliftIO m => m FilePath -> m (Maybe Msg)
 socketExists' getPath = do
   p <- getPath
-  r <- tryIOError $ getFileStatus p
+  r <- tryIO $ liftIO $ getFileStatus p
   return $ case r of
     Left e -> toErr $ T.pack $ ioe_description e
-    Right s -> if isSocket s then Nothing else toErr $ T.append (T.pack p) " is not a socket"
+    Right s | isSocket s -> Nothing
+    _ -> toErr $ T.append (T.pack p) " is not a socket"
   where
     toErr = Just . Msg LevelError
 

lib/XMonad/Internal/Command/Desktop.hs

@@ -46,9 +46,9 @@ import RIO
 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
+import UnliftIO.Directory
 import XMonad.Actions.Volume
 import XMonad.Core hiding (spawn)
 import XMonad.Internal.DBus.Common
@@ -136,7 +136,7 @@ runTMux = sometimesIO_ "terminal multiplexer" "tmux" deps act
     c = "exec tmux attach-session -d"
     msg = "could not connect to tmux session"
     socketName = do
-      u <- getEffectiveUserID
+      u <- liftIO getEffectiveUserID
       t <- getTemporaryDirectory
       return $ t </> "tmux-" ++ show u </> "default"
 

lib/XMonad/Internal/Command/Power.hs

@@ -34,8 +34,8 @@ import RIO
 import RIO.FilePath
 import qualified RIO.Process as P
 import qualified RIO.Text as T
-import System.Directory
 import System.IO.Error
+import UnliftIO.Directory
 import XMonad.Core hiding (spawn)
 import XMonad.Internal.Shell
 import qualified XMonad.Internal.Theme as XT

package.yaml

@@ -43,6 +43,7 @@ dependencies:
   - utf8-string >= 1.0.2
   - typed-process >= 0.2.8.0
   - network >= 3.1.2.7
+  - unliftio >= 0.2.21.0
 
 library:
   source-dirs: lib/