summaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
-rw-r--r--Plugins/Monitors/Top.hs36
1 files changed, 16 insertions, 20 deletions
diff --git a/Plugins/Monitors/Top.hs b/Plugins/Monitors/Top.hs
index 0d8d28e..911a079 100644
--- a/Plugins/Monitors/Top.hs
+++ b/Plugins/Monitors/Top.hs
@@ -19,7 +19,7 @@ module Plugins.Monitors.Top (startTop, topMemConfig, runTopMem) where
import Plugins.Monitors.Common
import Plugins.Monitors.Mem (usedMem)
-import Control.Exception (SomeException, handle, evaluate)
+import Control.Exception (SomeException, handle)
import System.Directory
import System.FilePath
import System.IO
@@ -64,16 +64,16 @@ showInfo nm sms mms = do
both <- showWithColors' (rnm ++ " " ++ sms) mms
return [nm, mstr, both]
+processes :: IO [FilePath]
+processes = fmap (filter isPid) (getDirectoryContents "/proc")
+ where isPid = all (`elem` ['0'..'9'])
+
getProcessData :: FilePath -> IO [String]
getProcessData pidf =
- handle ((\_ -> evaluate []) :: SomeException -> IO [String])
+ handle (const (return []) :: SomeException -> IO [String])
(withFile ("/proc" </> pidf </> "stat") ReadMode readWords)
where readWords = fmap words . hGetLine
-processes :: IO [FilePath]
-processes = fmap (filter isPid) (getDirectoryContents "/proc")
- where isPid = all (`elem` ['0'..'9'])
-
handleProcesses :: ([String] -> a) -> IO [a]
handleProcesses f =
fmap (foldr (\p ps -> if p == [] then ps else f p : ps) [])
@@ -88,9 +88,7 @@ sortTop = sortBy (flip (comparing snd))
type Meminfo = (String, Float)
meminfo :: [String] -> Meminfo
-meminfo fs = (n, r)
- where n = processName fs
- r = pageSize * read (fs!!23)
+meminfo fs = (processName fs, pageSize * read (fs!!23))
meminfos :: IO [Meminfo]
meminfos = handleProcesses meminfo
@@ -121,9 +119,9 @@ timeMemEntry fs = ((p, (n, t)), (n, r))
timeMemEntries :: IO [(TimeEntry, Meminfo)]
timeMemEntries = handleProcesses timeMemEntry
-timeMemInfos :: IO (Times, [Meminfo])
+timeMemInfos :: IO (Times, [Meminfo], Int)
timeMemInfos =
- fmap (\x -> (M.fromList . map fst $ x, map snd x)) timeMemEntries
+ fmap (\x -> (M.fromList . map fst $ x, map snd x, length x)) timeMemEntries
combineTimeInfos :: Times -> Times -> Times
combineTimeInfos t0 t1 = M.intersectionWith timeDiff t1 t0
@@ -132,13 +130,12 @@ combineTimeInfos t0 t1 = M.intersectionWith timeDiff t1 t0
topProcesses :: TimesRef -> Float -> IO (Int, ([TimeInfo], [Meminfo]))
topProcesses tref scale = do
c1 <- getCurrentTime
- (t1, mis) <- timeMemInfos
- (t0, c0) <- readIORef tref
- writeIORef tref (t1, c1)
- 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))
+ (t1, mis, len) <- timeMemInfos
+ atomicModifyIORef tref $ \(t0, c0) ->
+ let scx = (fromRational . toRational $ diffUTCTime c1 c0) * scale / 100
+ ts = M.elems $ combineTimeInfos t0 t1
+ nts = map (\(nm, t) -> (nm, t / scx)) ts
+ in ((t1, c1), (len, (sortTop nts, sortTop mis)))
showTimeInfo :: TimeInfo -> Monitor [String]
showTimeInfo (n, t) = showInfo n (showDigits 1 t) t
@@ -148,8 +145,7 @@ runTop tref scale mscale _ = do
(no, (ps, ms)) <- io $ topProcesses tref scale
pstr <- mapM showTimeInfo ps
mstr <- mapM (showMeminfo mscale) ms
- let nostr = no `seq` show no
- parseTemplate $ nostr : (concat $ zipWith (++) pstr mstr)
+ parseTemplate $! show no : concat (zipWith (++) pstr mstr)
startTop :: [String] -> Int -> (String -> IO ()) -> IO ()
startTop a r cb = do