diff options
| author | Jose Antonio Ortega Ruiz <jao@gnu.org> | 2010-12-19 15:41:14 +0100 | 
|---|---|---|
| committer | Jose Antonio Ortega Ruiz <jao@gnu.org> | 2010-12-19 16:02:55 +0100 | 
| commit | 2c91687f0d2a3bcfd39d0f70cb2f824574709989 (patch) | |
| tree | fb706875ac7d44c8c89ec4caaf277df9175939d4 /Plugins/Monitors | |
| parent | 7fd503bc560c256d8aa769343e69b766ddbc8c68 (diff) | |
| download | xmobar-2c91687f0d2a3bcfd39d0f70cb2f824574709989.tar.gz xmobar-2c91687f0d2a3bcfd39d0f70cb2f824574709989.tar.bz2 | |
Top refactorings
Diffstat (limited to 'Plugins/Monitors')
| -rw-r--r-- | Plugins/Monitors/Top.hs | 66 | 
1 files changed, 33 insertions, 33 deletions
| diff --git a/Plugins/Monitors/Top.hs b/Plugins/Monitors/Top.hs index 6af22e3..90cd16d 100644 --- a/Plugins/Monitors/Top.hs +++ b/Plugins/Monitors/Top.hs @@ -52,62 +52,59 @@ foreign import ccall "unistd.h getpagesize"  pageSize :: Float  pageSize = fromIntegral c_getpagesize / 1024 -showInfo :: String -> String -> Float -> Monitor [String] -showInfo nm sms mms = do -  mnw <- getConfigValue maxWidth -  mxw <- getConfigValue minWidth -  let lsms = length sms -      nmw = mnw - lsms - 1 -      nmx = mxw - lsms - 1 -      rnm = if nmw > 0 then padString nmw nmx " " True nm else nm -  mstr <- showWithColors' sms mms -  both <- showWithColors' (rnm ++ " " ++ sms) mms -  return [nm, mstr, both] - -ignoreErrors :: IO [String] -> IO [String] -ignoreErrors = handle returnEmpty -  where returnEmpty = const (return []) :: SomeException -> IO [String] -  processes :: IO [FilePath] -processes = ignoreErrors $ fmap (filter isPid) (getDirectoryContents "/proc") +processes = fmap (filter isPid) (getDirectoryContents "/proc")    where isPid = (`elem` ['0'..'9']) . head  getProcessData :: FilePath -> IO [String]  getProcessData pidf = -  ignoreErrors $ withFile ("/proc" </> pidf </> "stat") ReadMode readWords +  handle ign $ withFile ("/proc" </> pidf </> "stat") ReadMode readWords    where readWords = fmap words . hGetLine +        ign = const (return []) :: SomeException -> IO [String]  handleProcesses :: ([String] -> a) -> IO [a]  handleProcesses f =    fmap (foldl' (\a p -> if null p then a else f p : a) [])         (processes >>= mapM getProcessData) +showInfo :: String -> String -> Float -> Monitor [String] +showInfo nm sms mms = do +  mnw <- getConfigValue maxWidth +  mxw <- getConfigValue minWidth +  let lsms = length sms +      nmw = mnw - lsms - 1 +      nmx = mxw - lsms - 1 +      rnm = if nmw > 0 then padString nmw nmx " " True nm else nm +  mstr <- showWithColors' sms mms +  both <- showWithColors' (rnm ++ " " ++ sms) mms +  return [nm, mstr, both] +  processName :: [String] -> String  processName = drop 1 . init . (!!1)  sortTop :: [(a, Float)] -> [(a, Float)]  sortTop =  sortBy (flip (comparing snd)) -type Meminfo = (String, Float) +type MemInfo = (String, Float) -meminfo :: [String] -> Meminfo +meminfo :: [String] -> MemInfo  meminfo fs = (processName fs, pageSize * read (fs!!23)) -meminfos :: IO [Meminfo] +meminfos :: IO [MemInfo]  meminfos = handleProcesses meminfo -showMeminfo :: Float -> Meminfo -> Monitor [String] -showMeminfo scale (nm, rss) = +showMemInfo :: Float -> MemInfo -> Monitor [String] +showMemInfo scale (nm, rss) =    showInfo nm (showWithUnits 2 1 rss) (100 * rss / sc)    where sc = if scale > 0 then scale else 100 -showMeminfos :: [Meminfo] -> Monitor [[String]] -showMeminfos ms = mapM (showMeminfo tm) $ sortTop ms +showMemInfos :: [MemInfo] -> Monitor [[String]] +showMemInfos ms = mapM (showMemInfo tm) $ sortTop ms    where tm = sum (map snd ms)  runTopMem :: [String] -> Monitor String  runTopMem _ = do -  pstr <- io meminfos >>= showMeminfos +  pstr <- io meminfos >>= showMemInfos    parseTemplate $ concat pstr  type Pid = Int @@ -116,17 +113,17 @@ type TimeEntry = (Pid, TimeInfo)  type Times = [TimeEntry]  type TimesRef = IORef (Times, UTCTime) -timeMemEntry :: [String] -> (TimeEntry, Meminfo) +timeMemEntry :: [String] -> (TimeEntry, MemInfo)  timeMemEntry fs = ((p, (n, t)), (n, r))    where p = read (head fs)          n = processName fs          t = read (fs!!13) + read (fs!!14)          (_, r) = meminfo fs -timeMemEntries :: IO [(TimeEntry, Meminfo)] +timeMemEntries :: IO [(TimeEntry, MemInfo)]  timeMemEntries = handleProcesses timeMemEntry -timeMemInfos :: IO (Times, [Meminfo], Int) +timeMemInfos :: IO (Times, [MemInfo], Int)  timeMemInfos = fmap res timeMemEntries    where res x = (sortBy (comparing fst) $ map fst x, map snd x, length x) @@ -138,7 +135,7 @@ combine l@((p0, (n0, t0)):ls) r@((p1, (n1, t1)):rs)    | p0 < p1 = combine ls r    | otherwise = (p1, (n1, t1)) : combine l rs -topProcesses :: TimesRef -> Float -> IO (Int, [TimeInfo], [Meminfo]) +topProcesses :: TimesRef -> Float -> IO (Int, [TimeInfo], [MemInfo])  topProcesses tref scale = do    (t0, c0) <- readIORef tref    (t1', mis, len) <- timeMemInfos @@ -150,16 +147,19 @@ topProcesses tref scale = do        !scx' = if scx > 0 then scx else scale        ts = combine t0 t1        nts = map (\(_, (nm, t)) -> (nm, min 100 (t / scx'))) ts -  return (len, sortTop nts, mis) +  return (len, nts, mis)  showTimeInfo :: TimeInfo -> Monitor [String]  showTimeInfo (n, t) = showInfo n (showDigits 0 t) t +showTimeInfos :: [TimeInfo] -> Monitor [[String]] +showTimeInfos = mapM showTimeInfo . sortTop +  runTop :: TimesRef -> Float -> [String] -> Monitor String  runTop tref scale _ = do    (no, ps, ms) <- io $ topProcesses tref scale -  pstr <- mapM showTimeInfo ps -  mstr <- showMeminfos ms +  pstr <- showTimeInfos ps +  mstr <- showMemInfos ms    parseTemplate $ show no : concat (zipWith (++) pstr mstr) ++ repeat "N/A"  startTop :: [String] -> Int -> (String -> IO ()) -> IO () | 
