ENH generalize IO

This commit is contained in:
Nathan Dwarshuis 2022-12-31 16:13:45 -05:00
parent 71c875702f
commit c13de68d4f
1 changed files with 41 additions and 19 deletions

View File

@ -26,29 +26,28 @@ module XMonad.Internal.IO
where where
import Data.Char import Data.Char
import Data.Text (pack, unpack)
import Data.Text.IO as T (readFile, writeFile)
import RIO import RIO
import RIO.Directory import RIO.Directory
import RIO.FilePath import RIO.FilePath
import qualified RIO.Text as T
import System.IO.Error import System.IO.Error
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- read -- read
readInt :: (Read a, Integral a) => FilePath -> IO a readInt :: MonadIO m => (Read a, Integral a) => FilePath -> m a
readInt = fmap (read . takeWhile isDigit . unpack) . T.readFile readInt = fmap (read . takeWhile isDigit . T.unpack) . readFileUtf8
readBool :: FilePath -> IO Bool readBool :: MonadIO m => FilePath -> m Bool
readBool = fmap (== (1 :: Int)) . readInt readBool = fmap (== (1 :: Int)) . readInt
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- write -- write
writeInt :: (Show a, Integral a) => FilePath -> a -> IO () writeInt :: MonadIO m => (Show a, Integral a) => FilePath -> a -> m ()
writeInt f = T.writeFile f . pack . show writeInt f = writeFileUtf8 f . T.pack . show
writeBool :: FilePath -> Bool -> IO () writeBool :: MonadIO m => FilePath -> Bool -> m ()
writeBool f b = writeInt f ((if b then 1 else 0) :: Int) writeBool f b = writeInt f ((if b then 1 else 0) :: Int)
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -64,7 +63,7 @@ rawToPercent (lower, upper) raw =
-- rawToPercent upper raw = 100 * fromIntegral raw / fromIntegral upper -- rawToPercent upper raw = 100 * fromIntegral raw / fromIntegral upper
readPercent :: (Integral a, RealFrac b) => (a, a) -> FilePath -> IO b readPercent :: MonadIO m => (Integral a, RealFrac b) => (a, a) -> FilePath -> m b
readPercent bounds path = do readPercent bounds path = do
i <- readInt path i <- readInt path
return $ rawToPercent bounds (i :: Integer) return $ rawToPercent bounds (i :: Integer)
@ -74,7 +73,12 @@ percentToRaw (lower, upper) perc =
round $ round $
fromIntegral lower + perc / 100.0 * (fromIntegral upper - fromIntegral lower) fromIntegral lower + perc / 100.0 * (fromIntegral upper - fromIntegral lower)
writePercent :: (Integral a, RealFrac b) => (a, a) -> FilePath -> b -> IO b writePercent
:: (MonadIO m, Integral a, RealFrac b)
=> (a, a)
-> FilePath
-> b
-> m b
writePercent bounds path perc = do writePercent bounds path perc = do
let t let t
| perc > 100 = 100 | perc > 100 = 100
@ -83,29 +87,47 @@ writePercent bounds path perc = do
writeInt path (percentToRaw bounds t :: Int) writeInt path (percentToRaw bounds t :: Int)
return t return t
writePercentMin :: (Integral a, RealFrac b) => (a, a) -> FilePath -> IO b writePercentMin
:: (MonadIO m, Integral a, RealFrac b)
=> (a, a)
-> FilePath
-> m b
writePercentMin bounds path = writePercent bounds path 0 writePercentMin bounds path = writePercent bounds path 0
writePercentMax :: (Integral a, RealFrac b) => (a, a) -> FilePath -> IO b writePercentMax
:: (MonadIO m, Integral a, RealFrac b)
=> (a, a)
-> FilePath
-> m b
writePercentMax bounds path = writePercent bounds path 100 writePercentMax bounds path = writePercent bounds path 100
shiftPercent shiftPercent
:: (Integral a, RealFrac b) :: (MonadIO m, Integral a, RealFrac b)
=> (b -> b -> b) => (b -> b -> b)
-> Int -> Int
-> FilePath -> FilePath
-> (a, a) -> (a, a)
-> IO b -> m b
shiftPercent f steps path bounds = shiftPercent f steps path bounds =
writePercent bounds path . f stepsize writePercent bounds path . f stepsize
=<< readPercent bounds path =<< readPercent bounds path
where where
stepsize = 100 / fromIntegral steps stepsize = 100 / fromIntegral steps
incPercent :: (Integral a, RealFrac b) => Int -> FilePath -> (a, a) -> IO b incPercent
:: (MonadIO m, Integral a, RealFrac b)
=> Int
-> FilePath
-> (a, a)
-> m b
incPercent = shiftPercent (+) incPercent = shiftPercent (+)
decPercent :: (Integral a, RealFrac b) => Int -> FilePath -> (a, a) -> IO b decPercent
:: (MonadIO m, Integral a, RealFrac b)
=> Int
-> FilePath
-> (a, a)
-> m b
decPercent = shiftPercent subtract -- silly (-) operator thingy error decPercent = shiftPercent subtract -- silly (-) operator thingy error
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -119,9 +141,9 @@ data PermResult a = PermResult a | NotFoundError | PermError
-- fmap _ NotFoundError = NotFoundError -- fmap _ NotFoundError = NotFoundError
-- fmap _ PermError = PermError -- fmap _ PermError = PermError
getPermissionsSafe :: FilePath -> IO (PermResult Permissions) getPermissionsSafe :: MonadUnliftIO m => FilePath -> m (PermResult Permissions)
getPermissionsSafe f = do getPermissionsSafe f = do
r <- tryIOError $ getPermissions f r <- tryIO $ getPermissions f
return $ case r of return $ case r of
Right z -> PermResult z Right z -> PermResult z
Left (isPermissionError -> True) -> PermError Left (isPermissionError -> True) -> PermError
@ -139,7 +161,7 @@ getPermissionsSafe f = do
-- | Block until a PID has exited. -- | Block until a PID has exited.
-- Use this to control flow based on a process that was not explicitly started -- 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. -- by the Haskell runtime itself, and thus has no data structures to query.
waitUntilExit :: (Show t, Num t) => t -> IO () waitUntilExit :: (MonadIO m, Show t, Num t) => t -> m ()
waitUntilExit pid = do waitUntilExit pid = do
res <- doesDirectoryExist $ "/proc" </> show pid res <- doesDirectoryExist $ "/proc" </> show pid
when res $ do when res $ do