diff options
| -rw-r--r-- | Plugins/Monitors/Common.hs | 12 | ||||
| -rw-r--r-- | Plugins/Monitors/Top.hs | 23 |
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] |