diff options
| -rw-r--r-- | Plugins/Monitors.hs | 27 | ||||
| -rw-r--r-- | Plugins/Monitors/Disk.hs | 116 |
2 files changed, 132 insertions, 11 deletions
diff --git a/Plugins/Monitors.hs b/Plugins/Monitors.hs index 72e0d50..4943b69 100644 --- a/Plugins/Monitors.hs +++ b/Plugins/Monitors.hs @@ -27,18 +27,20 @@ import Plugins.Monitors.Batt import Plugins.Monitors.Thermal import Plugins.Monitors.CpuFreq import Plugins.Monitors.CoreTemp +import Plugins.Monitors.Disk -data Monitors = Weather Station Args Rate - | Network Interface Args Rate - | Memory Args Rate - | Swap Args Rate - | Cpu Args Rate - | MultiCpu Args Rate - | Battery Args Rate - | BatteryP [String] Args Rate - | Thermal Zone Args Rate - | CpuFreq Args Rate - | CoreTemp Args Rate +data Monitors = Weather Station Args Rate + | Network Interface Args Rate + | Memory Args Rate + | Swap Args Rate + | Cpu Args Rate + | MultiCpu Args Rate + | Battery Args Rate + | BatteryP [String] Args Rate + | Disk DiskSpec Args Rate + | Thermal Zone Args Rate + | CpuFreq Args Rate + | CoreTemp Args Rate deriving (Show,Read,Eq) type Args = [String] @@ -48,6 +50,7 @@ type Station = String type Zone = String type Interface = String type Rate = Int +type DiskSpec = [(String, String)] instance Exec Monitors where alias (Weather s _ _) = s @@ -61,6 +64,7 @@ instance Exec Monitors where alias (BatteryP _ _ _)= "battery" alias (CpuFreq _ _) = "cpufreq" alias (CoreTemp _ _) = "coretemp" + alias (Disk _ _ _) = "disk" start (Weather s a r) = runM (a ++ [s]) weatherConfig runWeather r start (Network i a r) = runM (a ++ [i]) netConfig runNet r start (Thermal z a r) = runM (a ++ [z]) thermalConfig runThermal r @@ -72,3 +76,4 @@ instance Exec Monitors where start (BatteryP s a r) = runM a battConfig (runBatt' s) r start (CpuFreq a r) = runM a cpuFreqConfig runCpuFreq r start (CoreTemp a r) = runM a coreTempConfig runCoreTemp r + start (Disk s a r) = runM a diskConfig (runDisk s) r diff --git a/Plugins/Monitors/Disk.hs b/Plugins/Monitors/Disk.hs new file mode 100644 index 0000000..64a0e7b --- /dev/null +++ b/Plugins/Monitors/Disk.hs @@ -0,0 +1,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 $ ds !! 0) ++ 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 + + + + |