summaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
-rw-r--r--Plugins/Monitors.hs2
-rw-r--r--Plugins/Monitors/Top.hs137
2 files changed, 66 insertions, 73 deletions
diff --git a/Plugins/Monitors.hs b/Plugins/Monitors.hs
index 69ee869..cba7332 100644
--- a/Plugins/Monitors.hs
+++ b/Plugins/Monitors.hs
@@ -85,5 +85,5 @@ instance Exec Monitors where
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
- start (TopCpu a r) = runM a topCpuConfig runTopCpu r
start (TopMem a r) = runM a topMemConfig runTopMem r
+ start (TopCpu a r) = startTopCpu a r
diff --git a/Plugins/Monitors/Top.hs b/Plugins/Monitors/Top.hs
index 0d9c6bd..14ccf1e 100644
--- a/Plugins/Monitors/Top.hs
+++ b/Plugins/Monitors/Top.hs
@@ -14,24 +14,31 @@
{-# LANGUAGE ForeignFunctionInterface #-}
-module Plugins.Monitors.Top ( topCpuConfig
- , runTopCpu
- , topMemConfig
- , runTopMem ) where
+module Plugins.Monitors.Top (startTopCpu, topMemConfig, runTopMem) where
import Plugins.Monitors.Common
--- import Control.Monad (zipWithM)
-import Control.Exception
+import Control.Exception (SomeException, handle, evaluate)
+import Control.Concurrent
import System.Directory
import System.FilePath
-import System.IO
+import System.Posix.Unistd (getSysVar, SysVar(ClockTick))
import Foreign.C.Types
import Data.List (sortBy, foldl')
-import Data.Ord (comparing)
+
import Data.IntMap (IntMap)
import qualified Data.IntMap as M
+
+topMemConfig :: IO MConfig
+topMemConfig = mkMConfig "<both1>" [ k ++ n | n <- map show [1..maxProc]
+ , k <- ["name", "rss", "both"]]
+
+topCpuConfig :: IO MConfig
+topCpuConfig = mkMConfig "<both1>" [ k ++ n | n <- map show [1..maxProc]
+ , k <- ["name", "cpu", "both"]]
+
+
foreign import ccall "unistd.h getpagesize"
c_getpagesize :: CInt
@@ -57,36 +64,34 @@ showInfo nm sms mms = do
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"]]
+defHandle :: a -> SomeException -> IO a
+defHandle def _ = evaluate $! def
+
+handlePidFile :: a -> ([String] -> IO a) -> FilePath -> IO a
+handlePidFile def action pidf =
+ handle (defHandle def) (fmap words (readFile f) >>= action)
+ where f = "/proc" </> pidf </> "stat"
+
+maxProc :: Int
+maxProc = 5
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
+meminfo = handlePidFile (MI "" 0) $ \fs ->
+ let m = pageSize * (read $! (fs !! 23))
+ n = drop 1 $! init (fs !! 1)
+ in evaluate $! MI n m
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
+topMemProcesses n = fmap (take n . sbm) meminfos
+ where sbm = sortBy cmp
+ cmp (MI _ x) (MI _ y) = compare y x
showMeminfo :: Meminfo -> Monitor [String]
showMeminfo (MI nm rss) =
@@ -96,69 +101,57 @@ showMeminfo (MI nm rss) =
runTopMem :: [String] -> Monitor String
runTopMem _ = do
- ps <- io $ topMemProcesses 5
+ ps <- io $ topMemProcesses maxProc
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
- h <- openFile "/proc/stat" ReadMode
- s <- hGetLine h
- let ts = (map read . tail . words) s
- hClose h
- return $! sum $! ts
-
-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 [(Integer, Times)]
+timeinfo = handlePidFile (TiV 0 "" 0) $ \fs ->
+ let pid = read (head fs)
+ rf = read . (fs!!)
+ n = drop 1 $ init (fs!!1)
+ in evaluate $! TiV pid n (rf 13 + rf 14)
+
+timeinfos :: IO Times
timeinfos = do
fs <- processes
tis <- mapM timeinfo $! fs
- ct <- cpuTime
- return $! [(ct, foldl' acc M.empty tis)]
+ return $! foldl' acc M.empty tis
where acc m (TiV p n t) = M.insert p (TI n t) 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, t0):_, (c1, t1):_) <- doActionTwiceWithDelay 1000000 timeinfos
+type TIVar = MVar Times
+
+topTimeProcesses :: Int -> TIVar -> Float -> IO [Timeinfo]
+topTimeProcesses n tivar lapse = do
+ t0 <- readMVar tivar
+ t1 <- timeinfos
+ modifyMVar_ tivar (\_ -> return $! t1)
let ts = M.elems $ combineTimeInfos t0 t1
- sts = take n $ sortBy (flip (comparing tm)) (filter nzr ts)
- nzr = (>0) . tm
- tm (TI _ t) = t
- lapse = fromIntegral (c1 - c0)
+ sts = take n $ sortBy cmp ts
+ cmp (TI _ x) (TI _ y) = compare y x
norm (TI nm t) = TI nm (100 * t / lapse)
- return $! map norm sts ++ replicate 5 (TI "" 0)
+ return $! map norm 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
+showTimeInfo (TI n t) = showInfo n (showDigits 1 t) t
+
+runTopCpu :: TIVar -> Float -> [String] -> Monitor String
+runTopCpu tivar lapse _ = do
+ ps <- io $ topTimeProcesses maxProc tivar lapse
+ pstr <- mapM showTimeInfo ps
+ parseTemplate $ concat pstr
+
+startTopCpu :: [String] -> Int -> (String -> IO ()) -> IO ()
+startTopCpu a r cb = do
+ t <- getSysVar ClockTick
+ tivar <- newMVar M.empty
+ let lapse = (fromIntegral r * fromIntegral t) / 10
+ runM a topCpuConfig (runTopCpu tivar lapse) r cb