summaryrefslogtreecommitdiffhomepage
path: root/Plugins/Monitors
diff options
context:
space:
mode:
Diffstat (limited to 'Plugins/Monitors')
-rw-r--r--Plugins/Monitors/Top.hs91
1 files changed, 41 insertions, 50 deletions
diff --git a/Plugins/Monitors/Top.hs b/Plugins/Monitors/Top.hs
index 02f42ff..0d8d28e 100644
--- a/Plugins/Monitors/Top.hs
+++ b/Plugins/Monitors/Top.hs
@@ -12,7 +12,7 @@
--
-----------------------------------------------------------------------------
-{-# LANGUAGE ForeignFunctionInterface, BangPatterns #-}
+{-# LANGUAGE ForeignFunctionInterface #-}
module Plugins.Monitors.Top (startTop, topMemConfig, runTopMem) where
@@ -33,23 +33,24 @@ import Data.Time.Clock
import Data.IntMap (IntMap)
import qualified Data.IntMap as M
+intStrs :: [String]
+intStrs = map show [(1::Int) ..]
topMemConfig :: IO MConfig
-topMemConfig = mkMConfig "<both1>" [ k ++ n | n <- map show [1..maxProc]
- , k <- ["name", "mem", "both"]]
+topMemConfig = mkMConfig "<both1>"
+ [ k ++ n | n <- intStrs , k <- ["name", "mem", "both"]]
topConfig :: IO MConfig
-topConfig = mkMConfig "<both1>" [ k ++ n | n <- map show [1..maxProc]
- , k <- [ "name", "cpu", "both"
- , "mname", "mem", "mboth"]]
-
-
+topConfig = mkMConfig "<both1>"
+ ("no" : [ k ++ n | n <- intStrs
+ , k <- [ "name", "cpu", "both"
+ , "mname", "mem", "mboth"]])
foreign import ccall "unistd.h getpagesize"
c_getpagesize :: CInt
-pageSize :: Int
-pageSize = fromIntegral c_getpagesize `div` 1024
+pageSize :: Float
+pageSize = fromIntegral c_getpagesize / 1024
showInfo :: String -> String -> Float -> Monitor [String]
showInfo nm sms mms = do
@@ -73,42 +74,35 @@ processes :: IO [FilePath]
processes = fmap (filter isPid) (getDirectoryContents "/proc")
where isPid = all (`elem` ['0'..'9'])
-handleProcesses :: a -> ([String] -> a) -> IO [a]
-handleProcesses def f = do
- ps <- processes
- pd <- mapM getProcessData $! ps
- return $! map (\x -> if x == [] then def else f x) pd
+handleProcesses :: ([String] -> a) -> IO [a]
+handleProcesses f =
+ fmap (foldr (\p ps -> if p == [] then ps else f p : ps) [])
+ (processes >>= mapM getProcessData)
processName :: [String] -> String
processName = drop 1 . init . (!!1)
-maxProc :: Int
-maxProc = 5
+sortTop :: [(a, Float)] -> [(a, Float)]
+sortTop = sortBy (flip (comparing snd))
-type Meminfo = (String, Int)
+type Meminfo = (String, Float)
meminfo :: [String] -> Meminfo
meminfo fs = (n, r)
- where !n = processName fs
- !r = pageSize * read (fs!!23)
+ where n = processName fs
+ r = pageSize * read (fs!!23)
meminfos :: IO [Meminfo]
-meminfos = handleProcesses ("", 0) meminfo
-
-topMemProcesses :: Int -> IO [Meminfo]
-topMemProcesses n = fmap (take n . sbm) meminfos
- where sbm = sortBy (flip (comparing snd))
+meminfos = handleProcesses meminfo
showMeminfo :: Float -> Meminfo -> Monitor [String]
showMeminfo scale (nm, rss) =
- showInfo nm sms (ms / (1024 * scale))
- where ms = fromIntegral rss
- sms = showWithUnits 2 1 ms
+ showInfo nm (showWithUnits 2 1 rss) (rss / (1024 * scale))
runTopMem :: [String] -> Monitor String
runTopMem _ = do
- ps <- io $ topMemProcesses maxProc
- pstr <- mapM (showMeminfo 1) ps
+ ps <- io meminfos
+ pstr <- mapM (showMeminfo 1) $ sortTop ps
parseTemplate $ concat pstr
type Pid = Int
@@ -119,46 +113,43 @@ type TimesRef = IORef (Times, UTCTime)
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)
+ where p = read (head fs)
+ n = processName fs
+ t = read (fs!!13) + read (fs!!14)
+ (_, r) = meminfo fs
timeMemEntries :: IO [(TimeEntry, Meminfo)]
-timeMemEntries = handleProcesses ((0, ("", 0)), ("", 0)) timeMemEntry
+timeMemEntries = handleProcesses timeMemEntry
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) = let !d = x1 - x0 in (n, d)
+combineTimeInfos t0 t1 = M.intersectionWith timeDiff t1 t0
+ where timeDiff (n, x1) (_, x0) = (n, x1 - x0)
-topProcesses :: Int -> TimesRef -> Float -> IO ([TimeInfo], [Meminfo])
-topProcesses n tref scale = do
+topProcesses :: TimesRef -> Float -> IO (Int, ([TimeInfo], [Meminfo]))
+topProcesses tref scale = do
c1 <- getCurrentTime
- (t1, mi) <- timeMemInfos
+ (t1, mis) <- timeMemInfos
(t0, c0) <- readIORef tref
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)
- mis = take n (sbm mi)
- sbm = sortBy (flip (comparing snd))
- return (nts, mis)
+ let scx = (fromRational . toRational $ diffUTCTime c1 c0) * scale / 100
+ ts = M.elems $ combineTimeInfos t0 t1
+ nts = map (\(nm, t) -> (nm, t / scx)) ts
+ return (M.size t1, (sortTop nts, sortTop mis))
showTimeInfo :: TimeInfo -> Monitor [String]
showTimeInfo (n, t) = showInfo n (showDigits 1 t) t
runTop :: TimesRef -> Float -> Float -> [String] -> Monitor String
runTop tref scale mscale _ = do
- (ps, ms) <- io $ topProcesses maxProc tref scale
+ (no, (ps, ms)) <- io $ topProcesses tref scale
pstr <- mapM showTimeInfo ps
mstr <- mapM (showMeminfo mscale) ms
- parseTemplate $ concat $ zipWith (++) pstr mstr
+ let nostr = no `seq` show no
+ parseTemplate $ nostr : (concat $ zipWith (++) pstr mstr)
startTop :: [String] -> Int -> (String -> IO ()) -> IO ()
startTop a r cb = do