summaryrefslogtreecommitdiffhomepage
path: root/Plugins/Monitors/Top.hs
diff options
context:
space:
mode:
authorJose A Ortega Ruiz <jao@gnu.org>2010-03-26 04:09:56 +0100
committerJose A Ortega Ruiz <jao@gnu.org>2010-03-26 04:09:56 +0100
commit9778203cf27e77a9ba6620423395a04642a640b7 (patch)
treea71fd48fccd37a89382144d39981ee4452b3c60d /Plugins/Monitors/Top.hs
parentf6b0e885b7359f60d6da826b3bf8ca4301bb5f8c (diff)
downloadxmobar-9778203cf27e77a9ba6620423395a04642a640b7.tar.gz
xmobar-9778203cf27e77a9ba6620423395a04642a640b7.tar.bz2
Less resource hungry Top monitors.
Ignore-this: f963302295a675773ab3bfd54e458a0d darcs-hash:20100326030956-748be-df70f254d1274a3f4b576df392cf6c30a0f1f582.gz
Diffstat (limited to 'Plugins/Monitors/Top.hs')
-rw-r--r--Plugins/Monitors/Top.hs92
1 files changed, 44 insertions, 48 deletions
diff --git a/Plugins/Monitors/Top.hs b/Plugins/Monitors/Top.hs
index 779cfbe..02f42ff 100644
--- a/Plugins/Monitors/Top.hs
+++ b/Plugins/Monitors/Top.hs
@@ -14,9 +14,10 @@
{-# LANGUAGE ForeignFunctionInterface, BangPatterns #-}
-module Plugins.Monitors.Top (startTopCpu, topMemConfig, runTopMem) where
+module Plugins.Monitors.Top (startTop, topMemConfig, runTopMem) where
import Plugins.Monitors.Common
+import Plugins.Monitors.Mem (usedMem)
import Control.Exception (SomeException, handle, evaluate)
import System.Directory
@@ -35,11 +36,12 @@ import qualified Data.IntMap as M
topMemConfig :: IO MConfig
topMemConfig = mkMConfig "<both1>" [ k ++ n | n <- map show [1..maxProc]
- , k <- ["name", "rss", "both"]]
+ , k <- ["name", "mem", "both"]]
-topCpuConfig :: IO MConfig
-topCpuConfig = mkMConfig "<both1>" [ k ++ n | n <- map show [1..maxProc]
- , k <- ["name", "cpu", "both"]]
+topConfig :: IO MConfig
+topConfig = mkMConfig "<both1>" [ k ++ n | n <- map show [1..maxProc]
+ , k <- [ "name", "cpu", "both"
+ , "mname", "mem", "mboth"]]
@@ -61,23 +63,11 @@ showInfo nm sms mms = do
both <- showWithColors' (rnm ++ " " ++ sms) mms
return [nm, mstr, both]
-strictReadFile :: FilePath -> IO String
-strictReadFile f =
- do hdl <- openFile f ReadMode
- xs <- getc hdl
- hClose hdl
- return xs
- where getc hdl = do e <- hIsEOF hdl
- if e then return []
- else do c <- hGetChar hdl
- cs <- getc hdl
- return (c:cs)
-
getProcessData :: FilePath -> IO [String]
getProcessData pidf =
handle ((\_ -> evaluate []) :: SomeException -> IO [String])
- (do s <- strictReadFile $ "/proc" </> pidf </> "stat"
- evaluate $! words s)
+ (withFile ("/proc" </> pidf </> "stat") ReadMode readWords)
+ where readWords = fmap words . hGetLine
processes :: IO [FilePath]
processes = fmap (filter isPid) (getDirectoryContents "/proc")
@@ -109,16 +99,16 @@ topMemProcesses :: Int -> IO [Meminfo]
topMemProcesses n = fmap (take n . sbm) meminfos
where sbm = sortBy (flip (comparing snd))
-showMeminfo :: Meminfo -> Monitor [String]
-showMeminfo (nm, rss) =
- showInfo nm sms (ms / 1024)
+showMeminfo :: Float -> Meminfo -> Monitor [String]
+showMeminfo scale (nm, rss) =
+ showInfo nm sms (ms / (1024 * scale))
where ms = fromIntegral rss
sms = showWithUnits 2 1 ms
runTopMem :: [String] -> Monitor String
runTopMem _ = do
ps <- io $ topMemProcesses maxProc
- pstr <- mapM showMeminfo ps
+ pstr <- mapM (showMeminfo 1) ps
parseTemplate $ concat pstr
type Pid = Int
@@ -127,47 +117,53 @@ type TimeEntry = (Pid, TimeInfo)
type Times = IntMap TimeInfo
type TimesRef = IORef (Times, UTCTime)
-timeEntry :: [String] -> TimeEntry
-timeEntry fs = (p, (n, t))
+timeMemEntry :: [String] -> (TimeEntry, Meminfo)
+timeMemEntry fs = ((p, (n, t)), (n, r))
where !p = read (head fs)
!n = processName fs
!t = read (fs!!13) + read (fs!!14)
+ !r = pageSize * read (fs!!23)
-timeEntries :: IO [TimeEntry]
-timeEntries = handleProcesses (0, ("", 0)) timeEntry
+timeMemEntries :: IO [(TimeEntry, Meminfo)]
+timeMemEntries = handleProcesses ((0, ("", 0)), ("", 0)) timeMemEntry
-timeinfos :: IO Times
-timeinfos = fmap M.fromList timeEntries
+timeMemInfos :: IO (Times, [Meminfo])
+timeMemInfos =
+ fmap (\x -> (M.fromList . map fst $ x, map snd x)) timeMemEntries
combineTimeInfos :: Times -> Times -> Times
combineTimeInfos !t0 !t1 = M.intersectionWith timeDiff t1 t0
- where timeDiff (n, x1) (_, x0) = (n, x1 - x0)
+ where timeDiff (n, x1) (_, x0) = let !d = x1 - x0 in (n, d)
-topTimeProcesses :: Int -> TimesRef -> Float -> IO [TimeInfo]
-topTimeProcesses n tref scale = do
- !c1 <- getCurrentTime
- !t1 <- timeinfos
+topProcesses :: Int -> TimesRef -> Float -> IO ([TimeInfo], [Meminfo])
+topProcesses n tref scale = do
+ c1 <- getCurrentTime
+ (t1, mi) <- timeMemInfos
(t0, c0) <- readIORef tref
- modifyIORef tref (const $! (t1, c1))
- let !ts = M.elems $ combineTimeInfos t0 t1
- !sts = take n $ sortBy (flip (comparing snd)) ts
- !nts = map norm sts
- !scx = (fromRational . toRational $! diffUTCTime c1 c0) * scale / 100
+ writeIORef tref (t1, c1)
+ let ts = M.elems $ combineTimeInfos t0 t1
+ sts = take n $ sortBy (flip (comparing snd)) ts
+ nts = map norm sts
+ scx = (fromRational . toRational $! diffUTCTime c1 c0) * scale / 100
norm (nm, t) = (nm, t / scx)
- return nts
+ mis = take n (sbm mi)
+ sbm = sortBy (flip (comparing snd))
+ return (nts, mis)
showTimeInfo :: TimeInfo -> Monitor [String]
showTimeInfo (n, t) = showInfo n (showDigits 1 t) t
-runTopCpu :: TimesRef -> Float -> [String] -> Monitor String
-runTopCpu tref scale _ = do
- ps <- io $ topTimeProcesses maxProc tref scale
- pstr <- mapM showTimeInfo ps
- parseTemplate $ concat pstr
+runTop :: TimesRef -> Float -> Float -> [String] -> Monitor String
+runTop tref scale mscale _ = do
+ (ps, ms) <- io $ topProcesses maxProc tref scale
+ pstr <- mapM showTimeInfo ps
+ mstr <- mapM (showMeminfo mscale) ms
+ parseTemplate $ concat $ zipWith (++) pstr mstr
-startTopCpu :: [String] -> Int -> (String -> IO ()) -> IO ()
-startTopCpu a r cb = do
+startTop :: [String] -> Int -> (String -> IO ()) -> IO ()
+startTop a r cb = do
cr <- getSysVar ClockTick
+ m <- usedMem
c <- getCurrentTime
tref <- newIORef (M.empty, c)
- runM a topCpuConfig (runTopCpu tref (fromIntegral cr)) r cb
+ runM a topConfig (runTop tref (fromIntegral cr) m) r cb