summaryrefslogtreecommitdiffhomepage
path: root/Plugins/Monitors/Disk.hs
diff options
context:
space:
mode:
authorJose A Ortega Ruiz <jao@gnu.org>2010-02-04 02:54:55 +0100
committerJose A Ortega Ruiz <jao@gnu.org>2010-02-04 02:54:55 +0100
commit6c4970ea293796a832ecd1b292ec99a9695bf276 (patch)
treeaf6ae522a14cfb75ef2434953ad87be17ba5fee9 /Plugins/Monitors/Disk.hs
parentcf25ae10fa019378c5aa5c7381275bd475c11ed4 (diff)
downloadxmobar-6c4970ea293796a832ecd1b292ec99a9695bf276.tar.gz
xmobar-6c4970ea293796a832ecd1b292ec99a9695bf276.tar.bz2
New DiskU and DiskIO monitors
Ignore-this: b72a9ad54c9ae478f2c3fbdcda4d26c8 New monitors for disk usage and throughput, replacing Disk. darcs-hash:20100204015455-748be-41e03ee9dff0e3e9e3725aae8a3e07c6facb70dc.gz
Diffstat (limited to 'Plugins/Monitors/Disk.hs')
-rw-r--r--Plugins/Monitors/Disk.hs159
1 files changed, 93 insertions, 66 deletions
diff --git a/Plugins/Monitors/Disk.hs b/Plugins/Monitors/Disk.hs
index 4f42218..3a9a70f 100644
--- a/Plugins/Monitors/Disk.hs
+++ b/Plugins/Monitors/Disk.hs
@@ -8,36 +8,41 @@
-- Stability : unstable
-- Portability : unportable
--
--- A disk usage monitor for Xmobar
+-- Disk usage and throughput monitors for Xmobar
--
-----------------------------------------------------------------------------
-module Plugins.Monitors.Disk (diskConfig, runDisk) where
+module Plugins.Monitors.Disk ( diskUConfig, runDiskU
+ , diskIOConfig, runDiskIO
+ ) where
-import qualified Data.ByteString.Lazy.Char8 as B
import Plugins.Monitors.Common
+import Plugins.Monitors.StatFS
+
+import Control.Monad (zipWithM)
+import qualified Data.ByteString.Lazy.Char8 as B
import Data.List (isPrefixOf, find, intercalate)
-import Numeric (floatToDigits)
-diskConfig :: IO MConfig
-diskConfig = mkMConfig "" ["total", "read", "write"]
+diskIOConfig :: IO MConfig
+diskIOConfig = mkMConfig "" ["total", "read", "write"]
+
+diskUConfig :: IO MConfig
+diskUConfig = mkMConfig "" ["size", "free", "used", "freep", "usedp"]
type DevName = String
type Path = String
-mountedDevices :: IO [(DevName, Path)]
-mountedDevices = do
+mountedDevices :: [String] -> IO [(DevName, Path)]
+mountedDevices req = 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 _ = ("", "")
- isDev (d, _) = "/dev/" `isPrefixOf` d
- undev (d, f) = (drop 5 d, f)
+ return (parse s)
+ where
+ parse = map undev . filter isDev . map (firstTwo . B.words) . B.lines
+ firstTwo (a:b:_) = (B.unpack a, B.unpack b)
+ firstTwo _ = ("", "")
+ isDev (d, p) = "/dev/" `isPrefixOf` d &&
+ (p `elem` req || drop 5 d `elem` req)
+ undev (d, f) = (drop 5 d, f)
diskData :: IO [(DevName, [Float])]
diskData = do
@@ -45,51 +50,39 @@ diskData = do
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
+mountedData :: [DevName] -> IO [(DevName, [Float])]
+mountedData devs = do
(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)
- _ -> (dev, path, [0, 0, 0])
- 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
- dat = if length xs > 6 then [sp, rSp, wSp] else [0, 0, 0]
- in (dev, path, dat)
-
-speedToStr :: Int -> Float -> String
-speedToStr n x
- | n > 2 || x < 103 = show (round x :: Int) ++ units n
- | x < 1024 = "0." ++ s2 (fst (floatToDigits 10 (x/1024))) ++ units (n+1)
- | otherwise = speedToStr (n+1) (x/1024)
- where units = (!!) ["B", "K", "M", "T"]
- s2 (a:b:_) = show a ++ show b
- s2 as = show (head as) ++ "0"
-
-runDisk' :: String -> [Float] -> Monitor String
-runDisk' tmp xs = do
- setConfigValue tmp template
- s <- mapM (showWithColors (speedToStr 1)) xs
- parseTemplate s
+ return $ map (parseDev (zipWith diff dt' dt)) devs
+ where diff (dev, xs) (_, ys) = (dev, zipWith (-) xs ys)
+
+parseDev :: [(DevName, [Float])] -> DevName -> (DevName, [Float])
+parseDev dat dev =
+ case find ((==dev) . fst) dat of
+ Nothing -> (dev, [0, 0, 0])
+ Just (_, 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
+ dat' = if length xs > 6 then [sp, rSp, wSp] else [0, 0, 0]
+ in (dev, dat')
+
+fsStats :: String -> IO [Integer]
+fsStats path = do
+ stats <- getFileSystemStats path
+ case stats of
+ Nothing -> return [-1, -1, -1]
+ Just f -> let tot = fsStatByteCount f
+ free = fsStatBytesAvailable f
+ used = fsStatBytesUsed f
+ in return [tot, free, used]
+
+speedToStr :: Float -> String
+speedToStr = showWithUnits 2 1
+
+sizeToStr :: Integer -> String
+sizeToStr = showWithUnits 3 0 . fromIntegral
findTempl :: DevName -> Path -> [(String, String)] -> String
findTempl dev path disks =
@@ -98,8 +91,42 @@ findTempl dev path disks =
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
+devTemplates :: [(String, String)]
+ -> [(DevName, Path)]
+ -> [(DevName, [Float])]
+ -> [(String, [Float])]
+devTemplates disks mounted dat =
+ map (\(d, p) -> (findTempl d p disks, findData d)) mounted
+ where findData dev = case find ((==dev) . fst) dat of
+ Nothing -> [0, 0, 0]
+ Just (_, xs) -> xs
+
+runDiskIO' :: (String, [Float]) -> Monitor String
+runDiskIO' (tmp, xs) = do
+ s <- mapM (showWithColors speedToStr) xs
+ setConfigValue tmp template
+ parseTemplate s
+
+runDiskIO :: [(String, String)] -> [String] -> Monitor String
+runDiskIO disks _ = do
+ mounted <- io $ mountedDevices (map fst disks)
+ dat <- io $ mountedData (map fst mounted)
+ strs <- mapM runDiskIO' $ devTemplates disks mounted dat
+ return $ intercalate " " strs
+
+runDiskU' :: String -> String -> Monitor String
+runDiskU' tmp path = do
+ setConfigValue tmp template
+ fstats <- io $ fsStats path
+ let strs = map sizeToStr fstats
+ freep = (fstats !! 1) * 100 `div` head fstats
+ fr = fromIntegral freep / 100
+ s <- zipWithM showWithColors' strs [100, freep, 100 - freep]
+ sp <- showPercentsWithColors [fr, 1 - fr]
+ parseTemplate $ s ++ sp
+
+runDiskU :: [(String, String)] -> [String] -> Monitor String
+runDiskU disks _ = do
+ devs <- io $ mountedDevices (map fst disks)
+ strs <- mapM (\(d, p) -> runDiskU' (findTempl d p disks) p) devs
return $ intercalate " " strs