summaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
-rw-r--r--Plugins/Monitors/Common.hs12
-rw-r--r--Plugins/Monitors/Top.hs23
2 files changed, 23 insertions, 12 deletions
diff --git a/Plugins/Monitors/Common.hs b/Plugins/Monitors/Common.hs
index e177e19..cc1a6a7 100644
--- a/Plugins/Monitors/Common.hs
+++ b/Plugins/Monitors/Common.hs
@@ -47,6 +47,8 @@ module Plugins.Monitors.Common (
, takeDigits
, showDigits
, floatToPercent
+ , parseFloat
+ , parseInt
, stringParser
-- * Threaded Actions
-- $thread
@@ -335,6 +337,16 @@ padString mnw mxw pad pr s =
else let ps = take (rlen - len) (cycle pad)
in if pr then s ++ ps else ps ++ s
+parseFloat :: String -> Float
+parseFloat s = case readFloat s of
+ (v, _):_ -> v
+ _ -> 0
+
+parseInt :: String -> Int
+parseInt s = case readDec s of
+ (v, _):_ -> v
+ _ -> 0
+
floatToPercent :: Float -> Monitor String
floatToPercent n =
do pad <- getConfigValue ppad
diff --git a/Plugins/Monitors/Top.hs b/Plugins/Monitors/Top.hs
index 90cd16d..03d83e2 100644
--- a/Plugins/Monitors/Top.hs
+++ b/Plugins/Monitors/Top.hs
@@ -64,7 +64,7 @@ getProcessData pidf =
handleProcesses :: ([String] -> a) -> IO [a]
handleProcesses f =
- fmap (foldl' (\a p -> if null p then a else f p : a) [])
+ fmap (foldl' (\a p -> if length p < 15 then a else f p : a) [])
(processes >>= mapM getProcessData)
showInfo :: String -> String -> Float -> Monitor [String]
@@ -82,13 +82,13 @@ showInfo nm sms mms = do
processName :: [String] -> String
processName = drop 1 . init . (!!1)
-sortTop :: [(a, Float)] -> [(a, Float)]
+sortTop :: [(String, Float)] -> [(String, Float)]
sortTop = sortBy (flip (comparing snd))
type MemInfo = (String, Float)
meminfo :: [String] -> MemInfo
-meminfo fs = (processName fs, pageSize * read (fs!!23))
+meminfo fs = (processName fs, pageSize * parseFloat (fs!!23))
meminfos :: IO [MemInfo]
meminfos = handleProcesses meminfo
@@ -115,9 +115,9 @@ type TimesRef = IORef (Times, UTCTime)
timeMemEntry :: [String] -> (TimeEntry, MemInfo)
timeMemEntry fs = ((p, (n, t)), (n, r))
- where p = read (head fs)
+ where p = parseInt (head fs)
n = processName fs
- t = read (fs!!13) + read (fs!!14)
+ t = parseFloat (fs!!13) + parseFloat (fs!!14)
(_, r) = meminfo fs
timeMemEntries :: IO [(TimeEntry, MemInfo)]
@@ -128,25 +128,24 @@ timeMemInfos = fmap res timeMemEntries
where res x = (sortBy (comparing fst) $ map fst x, map snd x, length x)
combine :: Times -> Times -> Times
-combine _ [] = []
-combine [] ts = ts
+combine ts [] = length ts `seq` []
+combine [] ts = length ts `seq` ts
combine l@((p0, (n0, t0)):ls) r@((p1, (n1, t1)):rs)
- | p0 == p1 = (p0, (n0, t1 - t0)) : combine ls rs
- | p0 < p1 = combine ls r
+ | p0 == p1 && n0 == n1 = (p0, (n0, t1 - t0)) : combine ls rs
+ | p0 <= p1 = combine ls r
| otherwise = (p1, (n1, t1)) : combine l rs
topProcesses :: TimesRef -> Float -> IO (Int, [TimeInfo], [MemInfo])
topProcesses tref scale = do
(t0, c0) <- readIORef tref
- (t1', mis, len) <- timeMemInfos
+ (t1, mis, len) <- timeMemInfos
c1 <- getCurrentTime
- let !t1 = t1'
- writeIORef tref (t1, c1)
let scx = realToFrac (diffUTCTime c1 c0) * scale
-- c0 and c1 can be equal, for instance, if we tweak the clock
!scx' = if scx > 0 then scx else scale
ts = combine t0 t1
nts = map (\(_, (nm, t)) -> (nm, min 100 (t / scx'))) ts
+ writeIORef tref (t1, c1)
return (len, nts, mis)
showTimeInfo :: TimeInfo -> Monitor [String]