module Xmobar.Plugins.Monitors.Disk.Linux
(
fetchDataIO
, fetchDataUsage
, initializeDevDataRef
, DevDataRef
) where
import Data.IORef (
IORef
, newIORef
, readIORef
, writeIORef
)
import Xmobar.System.StatFS (
getFileSystemStats
, fsStatByteCount
, fsStatBytesAvailable
, fsStatBytesUsed
)
import qualified Data.ByteString.Lazy.Char8 as B
import Data.List (isPrefixOf, find)
import Data.Maybe (catMaybes)
import System.Directory (canonicalizePath, doesFileExist)
import Control.Exception (SomeException, handle)
import Xmobar.Plugins.Monitors.Disk.Common (
DevName
, Path
)
type DevDataRef = IORef [(DevName, [Float])]
fsStats :: String -> IO [Integer]
fsStats :: DevName -> IO [Integer]
fsStats DevName
path = do
stats <- DevName -> IO (Maybe FileSystemStats)
getFileSystemStats DevName
path
case stats of
Maybe FileSystemStats
Nothing -> [Integer] -> IO [Integer]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Integer
0, Integer
0, Integer
0]
Just FileSystemStats
f -> let tot :: Integer
tot = FileSystemStats -> Integer
fsStatByteCount FileSystemStats
f
free :: Integer
free = FileSystemStats -> Integer
fsStatBytesAvailable FileSystemStats
f
used :: Integer
used = FileSystemStats -> Integer
fsStatBytesUsed FileSystemStats
f
in [Integer] -> IO [Integer]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Integer
tot, Integer
free, Integer
used]
mountedDevices :: [String] -> IO [(DevName, Path)]
mountedDevices :: [DevName] -> IO [(DevName, DevName)]
mountedDevices [DevName]
req = do
s <- DevName -> IO ByteString
B.readFile DevName
"/etc/mtab"
parse `fmap` mapM mbcanon (devs s)
where
mbcanon :: (DevName, b) -> IO (Maybe (DevName, b))
mbcanon (DevName
d, b
p) = DevName -> IO Bool
doesFileExist DevName
d IO Bool
-> (Bool -> IO (Maybe (DevName, b))) -> IO (Maybe (DevName, b))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
e ->
if Bool
e
then (DevName, b) -> Maybe (DevName, b)
forall a. a -> Maybe a
Just ((DevName, b) -> Maybe (DevName, b))
-> IO (DevName, b) -> IO (Maybe (DevName, b))
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (DevName, b) -> IO (DevName, b)
forall {b}. (DevName, b) -> IO (DevName, b)
canon (DevName
d,b
p)
else Maybe (DevName, b) -> IO (Maybe (DevName, b))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (DevName, b)
forall a. Maybe a
Nothing
canon :: (DevName, b) -> IO (DevName, b)
canon (DevName
d, b
p) = do {d' <- DevName -> IO DevName
canonicalizePath DevName
d; return (d', p)}
devs :: ByteString -> [(DevName, DevName)]
devs = ((DevName, DevName) -> Bool)
-> [(DevName, DevName)] -> [(DevName, DevName)]
forall a. (a -> Bool) -> [a] -> [a]
filter (DevName, DevName) -> Bool
forall {b}. (DevName, b) -> Bool
isDev ([(DevName, DevName)] -> [(DevName, DevName)])
-> (ByteString -> [(DevName, DevName)])
-> ByteString
-> [(DevName, DevName)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> (DevName, DevName))
-> [ByteString] -> [(DevName, DevName)]
forall a b. (a -> b) -> [a] -> [b]
map ([ByteString] -> (DevName, DevName)
firstTwo ([ByteString] -> (DevName, DevName))
-> (ByteString -> [ByteString]) -> ByteString -> (DevName, DevName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
B.words) ([ByteString] -> [(DevName, DevName)])
-> (ByteString -> [ByteString])
-> ByteString
-> [(DevName, DevName)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
B.lines
parse :: [Maybe (DevName, DevName)] -> [(DevName, DevName)]
parse = ((DevName, DevName) -> (DevName, DevName))
-> [(DevName, DevName)] -> [(DevName, DevName)]
forall a b. (a -> b) -> [a] -> [b]
map (DevName, DevName) -> (DevName, DevName)
forall {a} {b}. ([a], b) -> ([a], b)
undev ([(DevName, DevName)] -> [(DevName, DevName)])
-> ([Maybe (DevName, DevName)] -> [(DevName, DevName)])
-> [Maybe (DevName, DevName)]
-> [(DevName, DevName)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((DevName, DevName) -> Bool)
-> [(DevName, DevName)] -> [(DevName, DevName)]
forall a. (a -> Bool) -> [a] -> [a]
filter (DevName, DevName) -> Bool
isReq ([(DevName, DevName)] -> [(DevName, DevName)])
-> ([Maybe (DevName, DevName)] -> [(DevName, DevName)])
-> [Maybe (DevName, DevName)]
-> [(DevName, DevName)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (DevName, DevName)] -> [(DevName, DevName)]
forall a. [Maybe a] -> [a]
catMaybes
firstTwo :: [ByteString] -> (DevName, DevName)
firstTwo (ByteString
a:ByteString
b:[ByteString]
_) = (ByteString -> DevName
B.unpack ByteString
a, ByteString -> DevName
B.unpack ByteString
b)
firstTwo [ByteString]
_ = (DevName
"", DevName
"")
isDev :: (DevName, b) -> Bool
isDev (DevName
d, b
_) = DevName
"/dev/" DevName -> DevName -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` DevName
d
isReq :: (DevName, DevName) -> Bool
isReq (DevName
d, DevName
p) = DevName
p DevName -> [DevName] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [DevName]
req Bool -> Bool -> Bool
|| Int -> DevName -> DevName
forall a. Int -> [a] -> [a]
drop Int
5 DevName
d DevName -> [DevName] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [DevName]
req
undev :: ([a], b) -> ([a], b)
undev ([a]
d, b
f) = (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
5 [a]
d, b
f)
diskDevices :: [String] -> IO [(DevName, Path)]
diskDevices :: [DevName] -> IO [(DevName, DevName)]
diskDevices [DevName]
req = do
s <- DevName -> IO ByteString
B.readFile DevName
"/proc/diskstats"
parse `fmap` mapM canon (devs s)
where
canon :: (DevName, b) -> IO (DevName, b)
canon (DevName
d, b
p) = do {d' <- DevName -> IO DevName
canonicalizePath DevName
d; return (d', p)}
devs :: ByteString -> [(DevName, DevName)]
devs = (ByteString -> (DevName, DevName))
-> [ByteString] -> [(DevName, DevName)]
forall a b. (a -> b) -> [a] -> [b]
map ([ByteString] -> (DevName, DevName)
third ([ByteString] -> (DevName, DevName))
-> (ByteString -> [ByteString]) -> ByteString -> (DevName, DevName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
B.words) ([ByteString] -> [(DevName, DevName)])
-> (ByteString -> [ByteString])
-> ByteString
-> [(DevName, DevName)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
B.lines
parse :: [(DevName, DevName)] -> [(DevName, DevName)]
parse = ((DevName, DevName) -> (DevName, DevName))
-> [(DevName, DevName)] -> [(DevName, DevName)]
forall a b. (a -> b) -> [a] -> [b]
map (DevName, DevName) -> (DevName, DevName)
forall {a} {b}. ([a], b) -> ([a], b)
undev ([(DevName, DevName)] -> [(DevName, DevName)])
-> ([(DevName, DevName)] -> [(DevName, DevName)])
-> [(DevName, DevName)]
-> [(DevName, DevName)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((DevName, DevName) -> Bool)
-> [(DevName, DevName)] -> [(DevName, DevName)]
forall a. (a -> Bool) -> [a] -> [a]
filter (DevName, DevName) -> Bool
isReq
third :: [ByteString] -> (DevName, DevName)
third (ByteString
_:ByteString
_:ByteString
c:[ByteString]
_) = (DevName
"/dev/" DevName -> DevName -> DevName
forall a. [a] -> [a] -> [a]
++ ByteString -> DevName
B.unpack ByteString
c, ByteString -> DevName
B.unpack ByteString
c)
third [ByteString]
_ = (DevName
"", DevName
"")
isReq :: (DevName, DevName) -> Bool
isReq (DevName
d, DevName
p) = DevName
p DevName -> [DevName] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [DevName]
req Bool -> Bool -> Bool
|| Int -> DevName -> DevName
forall a. Int -> [a] -> [a]
drop Int
5 DevName
d DevName -> [DevName] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [DevName]
req
undev :: ([a], b) -> ([a], b)
undev ([a]
d, b
f) = (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
5 [a]
d, b
f)
mountedOrDiskDevices :: [String] -> IO [(DevName, Path)]
mountedOrDiskDevices :: [DevName] -> IO [(DevName, DevName)]
mountedOrDiskDevices [DevName]
req = do
mnt <- [DevName] -> IO [(DevName, DevName)]
mountedDevices [DevName]
req
case mnt of
[] -> [DevName] -> IO [(DevName, DevName)]
diskDevices [DevName]
req
[(DevName, DevName)]
other -> [(DevName, DevName)] -> IO [(DevName, DevName)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [(DevName, DevName)]
other
diskData :: IO [(DevName, [Float])]
diskData :: IO [(DevName, [Float])]
diskData = do
s <- DevName -> IO ByteString
B.readFile DevName
"/proc/diskstats"
let extract [DevName]
ws = ([DevName] -> DevName
forall a. HasCallStack => [a] -> a
head [DevName]
ws, (DevName -> b) -> [DevName] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map DevName -> b
forall a. Read a => DevName -> a
read ([DevName] -> [DevName]
forall a. HasCallStack => [a] -> [a]
tail [DevName]
ws))
return $ map (extract . map B.unpack . drop 2 . B.words) (B.lines s)
mountedData :: DevDataRef -> [DevName] -> IO [(DevName, [Float])]
mountedData :: DevDataRef -> [DevName] -> IO [(DevName, [Float])]
mountedData DevDataRef
dref [DevName]
devs = do
dt <- DevDataRef -> IO [(DevName, [Float])]
forall a. IORef a -> IO a
readIORef DevDataRef
dref
dt' <- diskData
writeIORef dref dt'
return $ map (parseDev (zipWith diff dt' dt)) devs
where diff :: (a, [c]) -> (a, [c]) -> (a, [c])
diff (a
dev, [c]
xs) (a
_, [c]
ys) = (a
dev, (c -> c -> c) -> [c] -> [c] -> [c]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) [c]
xs [c]
ys)
parseDev :: [(DevName, [Float])] -> DevName -> (DevName, [Float])
parseDev :: [(DevName, [Float])] -> DevName -> (DevName, [Float])
parseDev [(DevName, [Float])]
dat DevName
dev =
case ((DevName, [Float]) -> Bool)
-> [(DevName, [Float])] -> Maybe (DevName, [Float])
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((DevName -> DevName -> Bool
forall a. Eq a => a -> a -> Bool
==DevName
dev) (DevName -> Bool)
-> ((DevName, [Float]) -> DevName) -> (DevName, [Float]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DevName, [Float]) -> DevName
forall a b. (a, b) -> a
fst) [(DevName, [Float])]
dat of
Maybe (DevName, [Float])
Nothing -> (DevName
dev, [Float
0, Float
0, Float
0])
Just (DevName
_, [Float]
xs) ->
let r :: Float
r = Float
4096 Float -> Float -> Float
forall a. Num a => a -> a -> a
* [Float]
xs [Float] -> Int -> Float
forall a. HasCallStack => [a] -> Int -> a
!! Int
2
w :: Float
w = Float
4096 Float -> Float -> Float
forall a. Num a => a -> a -> a
* [Float]
xs [Float] -> Int -> Float
forall a. HasCallStack => [a] -> Int -> a
!! Int
6
t :: Float
t = Float
r Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
w
rSp :: Float
rSp = Float -> Float -> Float
forall {a}. (Eq a, Fractional a) => a -> a -> a
speed Float
r ([Float]
xs [Float] -> Int -> Float
forall a. HasCallStack => [a] -> Int -> a
!! Int
3)
wSp :: Float
wSp = Float -> Float -> Float
forall {a}. (Eq a, Fractional a) => a -> a -> a
speed Float
w ([Float]
xs [Float] -> Int -> Float
forall a. HasCallStack => [a] -> Int -> a
!! Int
7)
sp :: Float
sp = Float -> Float -> Float
forall {a}. (Eq a, Fractional a) => a -> a -> a
speed Float
t ([Float]
xs [Float] -> Int -> Float
forall a. HasCallStack => [a] -> Int -> a
!! Int
3 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ [Float]
xs [Float] -> Int -> Float
forall a. HasCallStack => [a] -> Int -> a
!! Int
7)
speed :: a -> a -> a
speed a
x a
d = if a
d a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 then a
0 else a
x a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
d
dat' :: [Float]
dat' = if [Float] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Float]
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
6
then [Float
sp, Float
rSp, Float
wSp, Float
t, Float
r, Float
w]
else [Float
0, Float
0, Float
0, Float
0, Float
0, Float
0]
in (DevName
dev, [Float]
dat')
fetchDataIO :: DevDataRef -> [(String, String)] -> IO [(String, [Float])]
fetchDataIO :: DevDataRef -> [(DevName, DevName)] -> IO [(DevName, [Float])]
fetchDataIO DevDataRef
dref [(DevName, DevName)]
disks = do
dev <- [DevName] -> IO [(DevName, DevName)]
mountedOrDiskDevices (((DevName, DevName) -> DevName)
-> [(DevName, DevName)] -> [DevName]
forall a b. (a -> b) -> [a] -> [b]
map (DevName, DevName) -> DevName
forall a b. (a, b) -> a
fst [(DevName, DevName)]
disks)
mountedData dref (map fst dev)
fetchDataUsage :: [(String, String)] -> IO [((String, String), [Integer])]
fetchDataUsage :: [(DevName, DevName)] -> IO [((DevName, DevName), [Integer])]
fetchDataUsage [(DevName, DevName)]
disks = do
devs <- [DevName] -> IO [(DevName, DevName)]
mountedDevices (((DevName, DevName) -> DevName)
-> [(DevName, DevName)] -> [DevName]
forall a b. (a -> b) -> [a] -> [b]
map (DevName, DevName) -> DevName
forall a b. (a, b) -> a
fst [(DevName, DevName)]
disks)
mapM fetchStats devs
where
fetchStats :: (String, String) -> IO ((String, String), [Integer])
fetchStats :: (DevName, DevName) -> IO ((DevName, DevName), [Integer])
fetchStats (DevName
dev, DevName
path) = do
stats <- (SomeException -> IO [Integer]) -> IO [Integer] -> IO [Integer]
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle SomeException -> IO [Integer]
ign (IO [Integer] -> IO [Integer]) -> IO [Integer] -> IO [Integer]
forall a b. (a -> b) -> a -> b
$ DevName -> IO [Integer]
fsStats DevName
path
return ((dev, path), stats)
ign :: SomeException -> IO [Integer]
ign = IO [Integer] -> SomeException -> IO [Integer]
forall a b. a -> b -> a
const ([Integer] -> IO [Integer]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Integer
0, Integer
0, Integer
0]) :: SomeException -> IO [Integer]
initializeDevDataRef :: [(String, String)] -> IO DevDataRef
initializeDevDataRef :: [(DevName, DevName)] -> IO DevDataRef
initializeDevDataRef [(DevName, DevName)]
disks = do
dev <- [DevName] -> IO [(DevName, DevName)]
mountedOrDiskDevices (((DevName, DevName) -> DevName)
-> [(DevName, DevName)] -> [DevName]
forall a b. (a -> b) -> [a] -> [b]
map (DevName, DevName) -> DevName
forall a b. (a, b) -> a
fst [(DevName, DevName)]
disks)
newIORef (map (\(DevName, DevName)
d -> ((DevName, DevName) -> DevName
forall a b. (a, b) -> a
fst (DevName, DevName)
d, Float -> [Float]
forall a. a -> [a]
repeat Float
0)) dev)