summaryrefslogtreecommitdiffhomepage
path: root/Plugins/Monitors
diff options
context:
space:
mode:
authorJose A Ortega Ruiz <jao@gnu.org>2010-02-11 01:38:57 +0100
committerJose A Ortega Ruiz <jao@gnu.org>2010-02-11 01:38:57 +0100
commit5d719b4cde41e27c28b8c6342ccc40d97af04370 (patch)
tree3e85896c249c350025cd8e608a7f7068eb45a5df /Plugins/Monitors
parent720c9ecadb0302f43769f743b706ffedfbd6b44c (diff)
downloadxmobar-5d719b4cde41e27c28b8c6342ccc40d97af04370.tar.gz
xmobar-5d719b4cde41e27c28b8c6342ccc40d97af04370.tar.bz2
First stab at top monitors
Ignore-this: c89a13a99236d416cba2ba285099a2d7 darcs-hash:20100211003857-748be-76b55377cc1c2793711bc4003619dd366af0aa5c.gz
Diffstat (limited to 'Plugins/Monitors')
-rw-r--r--Plugins/Monitors/Common.hs3
-rw-r--r--Plugins/Monitors/Top.hs161
2 files changed, 163 insertions, 1 deletions
diff --git a/Plugins/Monitors/Common.hs b/Plugins/Monitors/Common.hs
index a102036..6729397 100644
--- a/Plugins/Monitors/Common.hs
+++ b/Plugins/Monitors/Common.hs
@@ -35,6 +35,7 @@ module Plugins.Monitors.Common (
, parseTemplate
-- ** String Manipulation
-- $strings
+ , padString
, showWithColors
, showWithColors'
, showPercentsWithColors
@@ -296,7 +297,7 @@ showDigits 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
+ | n > 3 || x < 10^(d + 1) = 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"]
diff --git a/Plugins/Monitors/Top.hs b/Plugins/Monitors/Top.hs
new file mode 100644
index 0000000..1c9443f
--- /dev/null
+++ b/Plugins/Monitors/Top.hs
@@ -0,0 +1,161 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module : Plugins.Monitors.Top
+-- Copyright : (c) Jose A Ortega Ruiz
+-- License : BSD-style (see LICENSE)
+--
+-- Maintainer : Jose A Ortega Ruiz <jao@gnu.org>
+-- Stability : unstable
+-- Portability : unportable
+--
+-- Process activity and memory consumption monitors
+--
+-----------------------------------------------------------------------------
+
+{-# LANGUAGE ForeignFunctionInterface #-}
+
+module Plugins.Monitors.Top ( topCpuConfig
+ , runTopCpu
+ , topMemConfig
+ , runTopMem ) where
+
+import Plugins.Monitors.Common
+
+-- import Control.Monad (zipWithM)
+import Control.Exception
+import System.Directory
+import System.FilePath
+import Foreign.C.Types
+import Data.List (sortBy, foldl')
+import Data.Ord (comparing)
+import Data.IntMap (IntMap)
+import qualified Data.IntMap as M
+
+foreign import ccall "unistd.h getpagesize"
+ c_getpagesize :: CInt
+
+pageSize :: Int
+pageSize = fromIntegral c_getpagesize `div` 1024
+
+processes :: IO [FilePath]
+processes =
+ fmap (filter isPid) $ getDirectoryContents "/proc"
+ where
+ isPid (x:_) = x `elem` ['0'..'9']
+ isPid _ = False
+
+showInfo :: String -> String -> Float -> Monitor [String]
+showInfo nm sms mms = do
+ mnw <- getConfigValue maxWidth
+ mxw <- getConfigValue minWidth
+ let lsms = length sms
+ nmw = mnw - lsms - 1
+ nmx = mxw - lsms - 1
+ rnm = if nmw > 0 then padString nmw nmx " " True nm else nm
+ mstr <- showWithColors' sms mms
+ both <- showWithColors' (rnm ++ " " ++ sms) mms
+ return [nm, mstr, both]
+
+topMemConfig :: IO MConfig
+topMemConfig = mkMConfig
+ "<both1>"
+ [ k ++ n | n <- map show [1::Int .. 5]
+ , k <- ["name", "rss", "both"]]
+
+data Meminfo = MI !String !Int
+
+meminfo :: FilePath -> IO Meminfo
+meminfo pidf =
+ handle noInfo
+ (do s <- readFile $ "/proc" </> pidf </> "stat"
+ let fs = words s
+ m = pageSize * read (fs !! 23)
+ n = drop 1 $ init (fs !! 1)
+ evaluate $ MI n m)
+ where noInfo :: SomeException -> IO Meminfo
+ noInfo _ = evaluate $ MI "" 0
+
+meminfos :: IO [Meminfo]
+meminfos = do
+ fs <- processes
+ mapM meminfo fs
+
+sortByMem :: [Meminfo] -> [Meminfo]
+sortByMem ps = sortBy (flip (comparing rss)) ps
+ where rss (MI _ m) = m
+
+topMemProcesses :: Int -> IO [Meminfo]
+topMemProcesses n = fmap (take n . sortByMem) meminfos
+
+showMeminfo :: Meminfo -> Monitor [String]
+showMeminfo (MI nm rss) =
+ showInfo nm sms (ms / 1024)
+ where ms = fromIntegral rss
+ sms = showWithUnits 2 1 ms
+
+runTopMem :: [String] -> Monitor String
+runTopMem _ = do
+ ps <- io $ topMemProcesses 5
+ pstr <- mapM showMeminfo ps
+ parseTemplate $ concat pstr
+
+topCpuConfig :: IO MConfig
+topCpuConfig = mkMConfig
+ "<both1>"
+ [ k ++ n | n <- map show [1::Int .. 5]
+ , k <- ["name", "cpu", "both"]]
+
+data Timeinfo = TI !String !Float
+type Times = IntMap Timeinfo
+data TimesVal = TiV !Int !String !Float
+
+cpuTime :: IO Integer
+cpuTime = do
+ s <- readFile "/proc/stat"
+ let ts = map read . tail . words . (!!0) . lines
+ return $ sum (ts s)
+
+nullTimesVal :: TimesVal
+nullTimesVal = TiV 0 "" 0
+
+timeinfo :: FilePath -> IO TimesVal
+timeinfo pidf =
+ handle ((\_ -> evaluate nullTimesVal) :: SomeException -> IO TimesVal)
+ (do s <- readFile $ "/proc" </> pidf </> "stat"
+ let fs = words s
+ pid = read (head fs)
+ rf = read . (fs!!)
+ n = drop 1 $ init (fs!!1)
+ evaluate $ TiV pid n (rf 14 + rf 15))
+
+timeinfos :: IO [Times]
+timeinfos = do
+ fs <- processes
+ tis <- mapM timeinfo fs
+ return [foldl' acc M.empty tis]
+ where acc m (TiV p n t) = if p > 10 then M.insert p (TI n t) m else m
+
+combineTimeInfos :: Times -> Times -> Times
+combineTimeInfos t0 t1 = M.intersectionWith timeDiff t1 t0
+ where timeDiff (TI n x1) (TI _ x0) = TI n (x1 - x0)
+
+topTimeProcesses :: Int -> IO [Timeinfo]
+topTimeProcesses n = do
+ c0 <- cpuTime
+ (t0:_, t1:_) <- doActionTwiceWithDelay 500000 timeinfos
+ c1 <- cpuTime
+ let ts = M.elems $ combineTimeInfos t0 t1
+ sts = take n $ sortBy (flip (comparing tm)) ts
+ tm (TI _ t) = t
+ lapse = fromIntegral (c1 - c0) / 100
+ norm (TI nm t) = TI nm (t/lapse)
+ return $ if lapse > 0 then map norm sts else sts
+
+showTimeInfo :: Timeinfo -> Monitor [String]
+showTimeInfo (TI n t) = showInfo n (showDigits 2 t) t
+
+runTopCpu :: [String] -> Monitor String
+runTopCpu _ = do
+ ps <- io $ topTimeProcesses 5
+ pstr <- mapM showTimeInfo ps
+ parseTemplate $ concat pstr