ENH generalize IO
This commit is contained in:
parent
71c875702f
commit
c13de68d4f
|
@ -26,29 +26,28 @@ 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
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- read
|
||||
|
||||
readInt :: (Read a, Integral a) => FilePath -> IO a
|
||||
readInt = fmap (read . takeWhile isDigit . unpack) . T.readFile
|
||||
readInt :: MonadIO m => (Read a, Integral a) => FilePath -> m a
|
||||
readInt = fmap (read . takeWhile isDigit . T.unpack) . readFileUtf8
|
||||
|
||||
readBool :: FilePath -> IO Bool
|
||||
readBool :: MonadIO m => FilePath -> m Bool
|
||||
readBool = fmap (== (1 :: Int)) . readInt
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- write
|
||||
|
||||
writeInt :: (Show a, Integral a) => FilePath -> a -> IO ()
|
||||
writeInt f = T.writeFile f . pack . show
|
||||
writeInt :: MonadIO m => (Show a, Integral a) => FilePath -> a -> m ()
|
||||
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)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
@ -64,7 +63,7 @@ rawToPercent (lower, upper) raw =
|
|||
|
||||
-- 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
|
||||
i <- readInt path
|
||||
return $ rawToPercent bounds (i :: Integer)
|
||||
|
@ -74,7 +73,12 @@ percentToRaw (lower, upper) perc =
|
|||
round $
|
||||
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
|
||||
let t
|
||||
| perc > 100 = 100
|
||||
|
@ -83,29 +87,47 @@ writePercent bounds path perc = do
|
|||
writeInt path (percentToRaw bounds t :: Int)
|
||||
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
|
||||
|
||||
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
|
||||
|
||||
shiftPercent
|
||||
:: (Integral a, RealFrac b)
|
||||
:: (MonadIO m, Integral a, RealFrac b)
|
||||
=> (b -> b -> b)
|
||||
-> Int
|
||||
-> FilePath
|
||||
-> (a, a)
|
||||
-> IO b
|
||||
-> m b
|
||||
shiftPercent f steps path bounds =
|
||||
writePercent bounds path . f stepsize
|
||||
=<< readPercent bounds path
|
||||
where
|
||||
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 (+)
|
||||
|
||||
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
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
@ -119,9 +141,9 @@ data PermResult a = PermResult a | NotFoundError | PermError
|
|||
-- fmap _ NotFoundError = NotFoundError
|
||||
-- fmap _ PermError = PermError
|
||||
|
||||
getPermissionsSafe :: FilePath -> IO (PermResult Permissions)
|
||||
getPermissionsSafe :: MonadUnliftIO m => FilePath -> m (PermResult Permissions)
|
||||
getPermissionsSafe f = do
|
||||
r <- tryIOError $ getPermissions f
|
||||
r <- tryIO $ getPermissions f
|
||||
return $ case r of
|
||||
Right z -> PermResult z
|
||||
Left (isPermissionError -> True) -> PermError
|
||||
|
@ -139,7 +161,7 @@ getPermissionsSafe f = do
|
|||
-- | 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 :: (Show t, Num t) => t -> IO ()
|
||||
waitUntilExit :: (MonadIO m, Show t, Num t) => t -> m ()
|
||||
waitUntilExit pid = do
|
||||
res <- doesDirectoryExist $ "/proc" </> show pid
|
||||
when res $ do
|
||||
|
|
Loading…
Reference in New Issue