Cleaner Top.hs

Ignore-this: 5f1c77125b77d40b7d5e3a3db052c9c

darcs-hash:20100327023850-748be-a1894b8edc9b7202870956ee8a5e4ffbc730ddea.gz

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