diff --git a/lib/Data/Internal/Dependency.hs b/lib/Data/Internal/Dependency.hs index 510a38b..cf104d8 100644 --- a/lib/Data/Internal/Dependency.hs +++ b/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 :: SystemDependency -> FIO (Maybe Msg) +testSysDependency + :: (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 - . io - . socketExists' + IOTest_ (T.unwords ["test if", n, "socket exists"]) ful . 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 diff --git a/lib/XMonad/Internal/Command/Desktop.hs b/lib/XMonad/Internal/Command/Desktop.hs index 7efebab..8e7f583 100644 --- a/lib/XMonad/Internal/Command/Desktop.hs +++ b/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" diff --git a/lib/XMonad/Internal/Command/Power.hs b/lib/XMonad/Internal/Command/Power.hs index a26ac1f..f6b77ec 100644 --- a/lib/XMonad/Internal/Command/Power.hs +++ b/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 diff --git a/package.yaml b/package.yaml index e299e06..80ac40b 100644 --- a/package.yaml +++ b/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/