1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
|
-----------------------------------------------------------------------------
-- |
-- Module : Plugins.Monitors.Disk
-- Copyright : (c) Jose A Ortega Ruiz
-- License : BSD-style (see LICENSE)
--
-- Maintainer : Jose A Ortega Ruiz <jao@gnu.org>
-- Stability : unstable
-- Portability : unportable
--
-- A disk usage monitor for Xmobar
--
-----------------------------------------------------------------------------
module Plugins.Monitors.Disk (diskConfig, runDisk) where
import qualified Data.ByteString.Lazy.Char8 as B
import Plugins.Monitors.Common
import Data.List (isPrefixOf, find, intercalate)
import Numeric (floatToDigits)
diskConfig :: IO MConfig
diskConfig = mkMConfig "" ["total", "read", "write"]
type DevName = String
type Path = String
mountedDevices :: IO [(DevName, Path)]
mountedDevices = do
s <- B.readFile "/etc/mtab"
return (parseMountedDevices s)
parseMountedDevices :: B.ByteString -> [(DevName, Path)]
parseMountedDevices =
map undev . filter isDev . map (firstTwo . B.words) . B.lines
where
firstTwo (a:b:_) = (B.unpack a, B.unpack b)
firstTwo _ = error "Unexpected mtab format"
isDev (d, _) = "/dev/" `isPrefixOf` d
undev (d, f) = (drop 5 d, f)
diskData :: IO [(DevName, [Float])]
diskData = do
s <- B.readFile "/proc/diskstats"
let extract ws = (head ws, map read (tail ws))
return $ map (extract . map B.unpack . drop 2 . B.words) (B.lines s)
mountedData :: [String] -> IO [(DevName, Path, [Float])]
mountedData xs = do
devs <- mountedDevices
(dt, dt') <- doActionTwiceWithDelay 950000 diskData
return $ parseData xs devs dt dt'
parseData :: [String] -> [(DevName, Path)]
-> [(DevName, [Float])] -> [(DevName, [Float])]
-> [(DevName, Path, [Float])]
parseData reqs mounted dat dat2 =
let rm = filter isRequested mounted
isRequested (dev, path) = dev `elem` reqs || path `elem` reqs
findDat d = find ((==d) .fst)
format (dev, path) =
let f1 = findDat dev dat
f2 = findDat dev dat2
in
case (f1, f2) of
(Just (_, x), Just (_, y)) -> formatDev path (dev, zipWith (-) y x)
_ -> error $ "Device " ++ dev ++ "not found in diskstats"
in map format rm
formatDev :: Path -> (DevName, [Float]) -> (DevName, Path, [Float])
formatDev path (dev, xs) =
let rSp = speed (xs !! 2) (xs !! 3)
wSp = speed (xs !! 6) (xs !! 7)
sp = speed (xs !! 2 + xs !! 6) (xs !! 3 + xs !! 7)
speed x t = if t == 0 then 0 else 500 * x / t
in
(dev, path, [sp, rSp, wSp])
speedToStr :: Int -> Float -> String
speedToStr n x =
let units = ["B", "K", "M", "T"]
toI = round :: Float -> Integer
s y j = y ++ units !! j ++ "/s"
in
if n > 2 || x < 103 then
s (show $ toI x) n
else
if x < 1024 then
let (ds, _) = floatToDigits 10 (x / 1024)
tr = if length ds > 1 then show $ ds !! 1 else "0"
in s ("0." ++ show (head ds) ++ tr) (n + 1)
else
speedToStr (n + 1) (x / 1024)
runDisk' :: String -> [Float] -> Monitor String
runDisk' tmp xs = do
setConfigValue tmp template
s <- mapM (showWithColors (speedToStr 1)) xs
parseTemplate s
findTempl :: DevName -> Path -> [(String, String)] -> String
findTempl dev path disks =
case find devOrPath disks of
Just (_, t) -> t
Nothing -> ""
where devOrPath (d, _) = d == dev || d == path
runDisk :: [(String, String)] -> [String] -> Monitor String
runDisk disks _ = do
dat <- io $ mountedData (map fst disks)
strs <- mapM (\(d, p, xs) -> runDisk' (findTempl d p disks) xs) dat
return $ intercalate " " strs
|
