xmonad-config/lib/XMonad/Internal/IO.hs

180 lines
5.1 KiB
Haskell
Raw Normal View History

--------------------------------------------------------------------------------
2022-12-30 14:58:23 -05:00
-- Random IO-ish functions used throughtout xmonad
--
-- Most (probably all) of these functions are intended to work with sysfs where
-- some safe assumptions can be made about file contents.
module XMonad.Internal.IO
( readInt
, readBool
, readPercent
, writeInt
, writeBool
, writePercent
, writePercentMin
, writePercentMax
, decPercent
, incPercent
-- , isReadable
-- , isWritable
2022-12-30 14:58:23 -05:00
, PermResult (..)
, getPermissionsSafe
2022-12-29 00:06:55 -05:00
, waitUntilExit
2022-12-31 20:19:09 -05:00
, withOpenDisplay
2022-12-30 14:58:23 -05:00
)
where
2022-12-30 14:58:23 -05:00
import Data.Char
2022-12-31 20:19:09 -05:00
import Graphics.X11.Xlib.Display
import Graphics.X11.Xlib.Event
import Graphics.X11.Xlib.Types
import RIO hiding (Display)
2022-12-30 14:58:23 -05:00
import RIO.Directory
import RIO.FilePath
2022-12-31 16:13:45 -05:00
import qualified RIO.Text as T
2022-12-30 14:58:23 -05:00
import System.IO.Error
2022-12-31 16:18:51 -05:00
import System.Process
--------------------------------------------------------------------------------
2022-12-30 14:58:23 -05:00
-- read
2022-12-31 16:13:45 -05:00
readInt :: MonadIO m => (Read a, Integral a) => FilePath -> m a
2023-02-12 23:08:05 -05:00
readInt = fmap (fromMaybe 0 . readMaybe . takeWhile isDigit . T.unpack) . readFileUtf8
2022-12-31 16:13:45 -05:00
readBool :: MonadIO m => FilePath -> m Bool
2022-12-30 14:58:23 -05:00
readBool = fmap (== (1 :: Int)) . readInt
--------------------------------------------------------------------------------
2022-12-30 14:58:23 -05:00
-- write
2023-02-12 23:08:05 -05:00
writeInt :: (MonadIO m, Show a) => FilePath -> a -> m ()
2022-12-31 16:13:45 -05:00
writeInt f = writeFileUtf8 f . T.pack . show
2022-12-31 16:13:45 -05:00
writeBool :: MonadIO m => FilePath -> Bool -> m ()
writeBool f b = writeInt f ((if b then 1 else 0) :: Int)
--------------------------------------------------------------------------------
2022-12-30 14:58:23 -05:00
-- percent-based read/write
--
-- "Raw" values are whatever is stored in sysfs and "percent" is the user-facing
-- value. Assume that the file being read has a min of 0 and an unchanging max
-- given by a runtime argument, which is scaled linearly to the range 0-100
-- (percent).
2023-02-12 23:08:05 -05:00
rawToPercent :: (Integral a, Integral b, RealFrac c) => (a, a) -> b -> c
2021-11-21 00:42:40 -05:00
rawToPercent (lower, upper) raw =
100 * (fromIntegral raw - fromIntegral lower) / fromIntegral (upper - lower)
2022-12-30 14:58:23 -05:00
2021-11-21 00:42:40 -05:00
-- rawToPercent upper raw = 100 * fromIntegral raw / fromIntegral upper
2022-12-31 16:13:45 -05:00
readPercent :: MonadIO m => (Integral a, RealFrac b) => (a, a) -> FilePath -> m b
2021-11-21 00:42:40 -05:00
readPercent bounds path = do
i <- readInt path
2021-11-21 00:42:40 -05:00
return $ rawToPercent bounds (i :: Integer)
2021-11-21 00:42:40 -05:00
percentToRaw :: (Integral a, RealFrac b, Integral c) => (a, a) -> b -> c
2022-12-30 14:58:23 -05:00
percentToRaw (lower, upper) perc =
round $
fromIntegral lower + perc / 100.0 * (fromIntegral upper - fromIntegral lower)
2022-12-31 16:13:45 -05:00
writePercent
:: (MonadIO m, Integral a, RealFrac b)
=> (a, a)
-> FilePath
-> b
-> m b
2021-11-21 00:42:40 -05:00
writePercent bounds path perc = do
2022-12-30 14:58:23 -05:00
let t
| perc > 100 = 100
| perc < 0 = 0
| otherwise = perc
2021-11-21 00:42:40 -05:00
writeInt path (percentToRaw bounds t :: Int)
return t
2022-12-31 16:13:45 -05:00
writePercentMin
:: (MonadIO m, Integral a, RealFrac b)
=> (a, a)
-> FilePath
-> m b
2021-11-21 00:42:40 -05:00
writePercentMin bounds path = writePercent bounds path 0
2022-12-31 16:13:45 -05:00
writePercentMax
:: (MonadIO m, Integral a, RealFrac b)
=> (a, a)
-> FilePath
-> m b
2021-11-21 00:42:40 -05:00
writePercentMax bounds path = writePercent bounds path 100
2022-12-30 14:58:23 -05:00
shiftPercent
2022-12-31 16:13:45 -05:00
:: (MonadIO m, Integral a, RealFrac b)
2022-12-30 14:58:23 -05:00
=> (b -> b -> b)
-> Int
-> FilePath
-> (a, a)
2022-12-31 16:13:45 -05:00
-> m b
2022-12-30 14:58:23 -05:00
shiftPercent f steps path bounds =
writePercent bounds path . f stepsize
2021-11-21 00:42:40 -05:00
=<< readPercent bounds path
where
stepsize = 100 / fromIntegral steps
2022-12-31 16:13:45 -05:00
incPercent
:: (MonadIO m, Integral a, RealFrac b)
=> Int
-> FilePath
-> (a, a)
-> m b
incPercent = shiftPercent (+)
2022-12-31 16:13:45 -05:00
decPercent
:: (MonadIO m, Integral a, RealFrac b)
=> Int
-> FilePath
-> (a, a)
-> m b
decPercent = shiftPercent subtract -- silly (-) operator thingy error
--------------------------------------------------------------------------------
2022-12-30 14:58:23 -05:00
-- permission query
data PermResult a = PermResult a | NotFoundError | PermError
deriving (Show, Eq)
-- instance Functor PermResult where
-- fmap f (PermResult r) = PermResult $ f r
-- fmap _ NotFoundError = NotFoundError
-- fmap _ PermError = PermError
2022-12-31 16:13:45 -05:00
getPermissionsSafe :: MonadUnliftIO m => FilePath -> m (PermResult Permissions)
getPermissionsSafe f = do
2022-12-31 16:13:45 -05:00
r <- tryIO $ getPermissions f
return $ case r of
2022-12-30 14:58:23 -05:00
Right z -> PermResult z
Left (isPermissionError -> True) -> PermError
Left (isDoesNotExistError -> True) -> NotFoundError
-- the above error should be the only ones thrown by getPermission,
-- so the catchall case should never happen
2022-12-30 14:58:23 -05:00
_ -> error "Unknown permission error"
-- isReadable :: FilePath -> IO (PermResult Bool)
-- isReadable = fmap (fmap readable) . getPermissionsSafe
-- isWritable :: FilePath -> IO (PermResult Bool)
-- isWritable = fmap (fmap writable) . getPermissionsSafe
2022-12-29 00:06:55 -05:00
-- | Block until a PID has exited.
-- Use this to control flow based on a process that was not explicitly started
-- by the Haskell runtime itself, and thus has no data structures to query.
waitUntilExit :: (MonadUnliftIO m) => Pid -> m ()
2022-12-29 00:06:55 -05:00
waitUntilExit pid = do
res <- doesDirectoryExist $ "/proc" </> show pid
when res $ do
threadDelay 100000
waitUntilExit pid
2022-12-31 20:19:09 -05:00
withOpenDisplay :: MonadUnliftIO m => (Display -> m a) -> m a
withOpenDisplay = bracket (liftIO $ openDisplay "") cleanup
where
cleanup dpy = liftIO $ do
flush dpy
closeDisplay dpy