Cleaner strictness annotations in Top.hs

Ignore-this: 9561a7cb943dede21eeeb792ec74bcf5

darcs-hash:20100212134843-748be-455daa6b02eaa49db3a8ac01b5758edd0aed4f45.gz

1 files changed, 35 insertions, 33 deletions

diff --git a/Plugins/Monitors/Top.hs b/Plugins/Monitors/Top.hs
index a0b3fb7..3473785 100644
--- a/Plugins/Monitors/Top.hs
+++ b/Plugins/Monitors/Top.hs
@@ -25,6 +25,7 @@ import System.FilePath
 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
@@ -65,7 +66,7 @@ showInfo nm sms mms = do
   return [nm, mstr, both]
 
 defHandle :: a -> SomeException -> IO a
-defHandle def _ = evaluate $! def
+defHandle def _ = evaluate def
 
 handlePidFile :: a -> ([String] -> IO a) -> FilePath -> IO a
 handlePidFile def action pidf =
@@ -75,13 +76,13 @@ handlePidFile def action pidf =
 maxProc :: Int
 maxProc = 5
 
-data Meminfo = MI !String !Int
+type Meminfo = (String, Int)
 
 meminfo :: FilePath -> IO Meminfo
-meminfo = handlePidFile (MI "" 0) $ \fs ->
-  let m = pageSize * (read $! (fs !! 23))
-      n = drop 1 $! init (fs !! 1)
-  in evaluate $! MI n m
+meminfo = handlePidFile ("", 0) $ \fs ->
+  let !m = pageSize * read (fs !! 23)
+      !n = drop 1 $ init (fs !! 1)
+  in evaluate (n, m)
 
 meminfos :: IO [Meminfo]
 meminfos = do
@@ -90,11 +91,10 @@ meminfos = do
 
 topMemProcesses :: Int -> IO [Meminfo]
 topMemProcesses n = fmap (take n . sbm) meminfos
-  where sbm = sortBy cmp
-        cmp (MI _ x) (MI _ y) = compare y x
+  where sbm = sortBy (flip (comparing snd))
 
 showMeminfo :: Meminfo -> Monitor [String]
-showMeminfo (MI nm rss) =
+showMeminfo (nm, rss) =
   showInfo nm sms (ms / 1024)
     where ms = fromIntegral rss
           sms = showWithUnits 2 1 ms
@@ -105,45 +105,47 @@ runTopMem _ = do
   pstr <- mapM showMeminfo ps
   parseTemplate $ concat pstr
 
-data Timeinfo = TI !String !Float
-type Times = IntMap Timeinfo
-data TimesVal = TiV !Int !String !Float
+type Pid = Int
+type TimeInfo = (String, Float)
+type TimeEntry = (Pid, TimeInfo)
+type Times = IntMap TimeInfo
+type TIVar = MVar Times
 
-timeinfo :: FilePath -> IO TimesVal
-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)
+timeinfo :: FilePath -> IO TimeEntry
+timeinfo = handlePidFile (0, ("", 0)) $ \fs ->
+  let rf = read . (fs!!)
+      !pid = read (head fs)
+      !n = drop 1 $ init (fs!!1)
+      !t = rf 13 + rf 14
+  in evaluate $ (pid, (n, t))
 
 timeinfos :: IO Times
 timeinfos = do
   fs <- processes
   tis <- mapM timeinfo $! fs
-  return $! foldl' acc M.empty tis
-  where acc m (TiV p n t) = M.insert p (TI n t) m
+  return $ foldl' acc M.empty tis
+  where acc m (p, (n, t)) = M.insert p (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)
-
-type TIVar = MVar Times
+combineTimeInfos !t0 !t1 = M.intersectionWith timeDiff t1 t0
+  where timeDiff (n, x1) (_, x0) = (n, (x1 - x0))
 
-topTimeProcesses :: Int -> TIVar -> Float -> IO [Timeinfo]
+topTimeProcesses :: Int -> TIVar -> Float -> IO [TimeInfo]
 topTimeProcesses n tivar lapse = do
   modifyMVar tivar $ \t0 ->
-    timeinfos >>= (\(!t1) -> let ts = M.elems $ combineTimeInfos t0 t1
-                                 sts = take n $ sortBy cmp ts
-                                 cmp (TI _ x) (TI _ y) = compare y x
-                                 norm (TI nm t) = TI nm (100 * t / lapse)
-                             in return $! (t1, map norm sts))
+    timeinfos >>= (\t1 ->
+                    let !ts = M.elems $ combineTimeInfos t0 t1
+                        !sts = take n $ sortBy (flip (comparing snd)) ts
+                        !nts = map norm sts
+                        norm (nm, t) = (nm, 100 * t / lapse)
+                    in return $ (t1, nts))
 
-showTimeInfo :: Timeinfo -> Monitor [String]
-showTimeInfo (TI n t) = showInfo n (showDigits 1 t) t
+showTimeInfo :: TimeInfo -> Monitor [String]
+showTimeInfo (n, t) = showInfo n (showDigits 1 t) t
 
 runTopCpu :: TIVar -> Float -> [String] -> Monitor String
 runTopCpu tivar lapse _ = do
-   ps <- io $! topTimeProcesses maxProc tivar lapse
+   ps <- io $ topTimeProcesses maxProc tivar lapse
    pstr <- mapM showTimeInfo ps
    parseTemplate $ concat pstr