ENH generalize IO
This commit is contained in:
parent
71c875702f
commit
c13de68d4f
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue