diff options
| -rw-r--r-- | Plugins/Monitors.hs | 31 | ||||
| -rw-r--r-- | Plugins/Monitors/Common.hs | 13 | ||||
| -rw-r--r-- | Plugins/Monitors/Disk.hs | 159 | ||||
| -rw-r--r-- | Plugins/Monitors/StatFS.hsc | 72 | ||||
| -rw-r--r-- | xmobar.cabal | 5 |
5 files changed, 198 insertions, 82 deletions
diff --git a/Plugins/Monitors.hs b/Plugins/Monitors.hs index 4943b69..c8d7e83 100644 --- a/Plugins/Monitors.hs +++ b/Plugins/Monitors.hs @@ -37,7 +37,8 @@ data Monitors = Weather Station Args Rate | MultiCpu Args Rate | Battery Args Rate | BatteryP [String] Args Rate - | Disk DiskSpec Args Rate + | DiskU DiskSpec Args Rate + | DiskIO DiskSpec Args Rate | Thermal Zone Args Rate | CpuFreq Args Rate | CoreTemp Args Rate @@ -64,16 +65,18 @@ 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 - start (Memory a r) = runM a memConfig runMem r - start (Swap a r) = runM a swapConfig runSwap r - start (Cpu a r) = runM a cpuConfig runCpu r - start (MultiCpu a r) = runM a multiCpuConfig runMultiCpu r - start (Battery a r) = runM a battConfig runBatt r - 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 + alias (DiskU _ _ _) = "disku" + alias (DiskIO _ _ _) = "diskio" + 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 + start (Memory a r) = runM a memConfig runMem r + start (Swap a r) = runM a swapConfig runSwap r + start (Cpu a r) = runM a cpuConfig runCpu r + start (MultiCpu a r) = runM a multiCpuConfig runMultiCpu r + start (Battery a r) = runM a battConfig runBatt r + 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 (DiskU s a r) = runM a diskUConfig (runDiskU s) r + start (DiskIO s a r) = runM a diskIOConfig (runDiskIO s) r diff --git a/Plugins/Monitors/Common.hs b/Plugins/Monitors/Common.hs index 060a5bc..a102036 100644 --- a/Plugins/Monitors/Common.hs +++ b/Plugins/Monitors/Common.hs @@ -36,7 +36,9 @@ module Plugins.Monitors.Common ( -- ** String Manipulation -- $strings , showWithColors + , showWithColors' , showPercentsWithColors + , showWithUnits , takeDigits , showDigits , floatToPercent @@ -291,6 +293,14 @@ showDigits :: Int -> Float -> String showDigits d n = showFFloat (Just d) n "" +showWithUnits :: Int -> Int -> Float -> String +showWithUnits d n x + | x < 0 = "-" ++ showWithUnits d n (-x) + | n > 3 || x < 10^d = show (round x :: Int) ++ units n + | x <= 1024 = showDigits d (x/1024) ++ units (n+1) + | otherwise = showWithUnits d (n+1) (x/1024) + where units = (!!) ["B", "K", "M", "G", "T"] + padString :: Int -> Int -> String -> Bool -> String -> String padString mnw mxw pad pr s = let len = length s @@ -339,6 +349,9 @@ showWithColors f x = [col normalColor | x > ll ] ++ [col lowColor | True] +showWithColors' :: (Num a, Ord a) => String -> a -> Monitor String +showWithColors' str v = showWithColors (const str) v + showPercentsWithColors :: [Float] -> Monitor [String] showPercentsWithColors fs = do fstrs <- mapM floatToPercent fs 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 diff --git a/Plugins/Monitors/StatFS.hsc b/Plugins/Monitors/StatFS.hsc new file mode 100644 index 0000000..ad3b659 --- /dev/null +++ b/Plugins/Monitors/StatFS.hsc @@ -0,0 +1,72 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Plugins.Monitors.StatFS +-- Copyright : (c) Jose A Ortega Ruiz +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Jose A Ortega Ruiz <jao@gnu.org> +-- Stability : unstable +-- Portability : unportable +-- +-- A binding to C's statvfs(2) +-- +----------------------------------------------------------------------------- + +{-# LANGUAGE CPP, ForeignFunctionInterface, EmptyDataDecls #-} + + +module Plugins.Monitors.StatFS (FileSystemStats(..), getFileSystemStats) where + +import Foreign +import Foreign.C.Types +import Foreign.C.String +import Foreign.Storable +import Data.ByteString (useAsCString) +import Data.ByteString.Char8 (pack) + +#include <sys/vfs.h> + +data FileSystemStats = FileSystemStats { + fsStatBlockSize :: Integer + -- ^ Optimal transfer block size. + , fsStatBlockCount :: Integer + -- ^ Total data blocks in file system. + , fsStatByteCount :: Integer + -- ^ Total bytes in file system. + , fsStatBytesFree :: Integer + -- ^ Free bytes in file system. + , fsStatBytesAvailable :: Integer + -- ^ Free bytes available to non-superusers. + , fsStatBytesUsed :: Integer + -- ^ Bytes used. + } deriving (Show, Eq) + +data CStatfs + +foreign import ccall unsafe "sys/vfs.h statfs64" + c_statfs :: CString -> Ptr CStatfs -> IO CInt + +toI :: CLong -> Integer +toI = toInteger + +getFileSystemStats :: String -> IO (Maybe FileSystemStats) +getFileSystemStats path = + allocaBytes (#size struct statfs) $ \vfs -> + useAsCString (pack path) $ \cpath -> do + res <- c_statfs cpath vfs + case res of + -1 -> return Nothing + _ -> do + bsize <- (#peek struct statfs, f_bsize) vfs + bcount <- (#peek struct statfs, f_blocks) vfs + bfree <- (#peek struct statfs, f_bfree) vfs + bavail <- (#peek struct statfs, f_bavail) vfs + let bpb = toI bsize + return $ Just FileSystemStats + { fsStatBlockSize = bpb + , fsStatBlockCount = toI bcount + , fsStatByteCount = toI bcount * bpb + , fsStatBytesFree = toI bfree * bpb + , fsStatBytesAvailable = toI bavail * bpb + , fsStatBytesUsed = toI (bcount - bfree) * bpb + } diff --git a/xmobar.cabal b/xmobar.cabal index 6fb7ffe..34b37c2 100644 --- a/xmobar.cabal +++ b/xmobar.cabal @@ -4,8 +4,8 @@ homepage: http://code.haskell.org/~arossato/xmobar synopsis: A Minimalistic Text Based Status Bar description: Xmobar is a minimalistic text based status bar. . - Inspired by the Ion3 status bar, it supports similar features, - like dynamic color management, output templates, and extensibility + Inspired by the Ion3 status bar, it supports similar features, + like dynamic color management, output templates, and extensibility through plugins. category: System license: BSD3 @@ -34,6 +34,7 @@ flag with_inotify executable xmobar main-is: Main.hs other-Modules: Xmobar, Config, Parsers, Commands, XUtil, Runnable, Plugins + ghc-options: -funbox-strict-fields -Wall ghc-prof-options: -prof -auto-all if true |