summaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
authorJose Antonio Ortega Ruiz <jao@gnu.org>2010-12-19 15:41:14 +0100
committerJose Antonio Ortega Ruiz <jao@gnu.org>2010-12-19 16:02:55 +0100
commit2c91687f0d2a3bcfd39d0f70cb2f824574709989 (patch)
treefb706875ac7d44c8c89ec4caaf277df9175939d4
parent7fd503bc560c256d8aa769343e69b766ddbc8c68 (diff)
downloadxmobar-2c91687f0d2a3bcfd39d0f70cb2f824574709989.tar.gz
xmobar-2c91687f0d2a3bcfd39d0f70cb2f824574709989.tar.bz2
Top refactorings
-rw-r--r--Plugins/Monitors/Top.hs66
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 ()