diff options
Diffstat (limited to 'Plugins')
| -rw-r--r-- | Plugins/Monitors.hs | 6 | ||||
| -rw-r--r-- | Plugins/Monitors/Mem.hs | 14 | ||||
| -rw-r--r-- | Plugins/Monitors/Top.hs | 92 | 
3 files changed, 57 insertions, 55 deletions
| diff --git a/Plugins/Monitors.hs b/Plugins/Monitors.hs index 2aff132..158a990 100644 --- a/Plugins/Monitors.hs +++ b/Plugins/Monitors.hs @@ -48,7 +48,7 @@ data Monitors = Weather  Station    Args Rate                | Thermal  Zone       Args Rate                | CpuFreq  Args       Rate                | CoreTemp Args       Rate -              | TopCpu   Args       Rate +              | TopProc  Args       Rate                | TopMem   Args       Rate  #ifdef IWLIB                | Wireless Interface  Args Rate @@ -75,7 +75,7 @@ instance Exec Monitors where      alias (Battery    _ _) = "battery"      alias (BatteryP  _ _ _)= "battery"      alias (CpuFreq    _ _) = "cpufreq" -    alias (TopCpu     _ _) = "top" +    alias (TopProc    _ _) = "top"      alias (TopMem     _ _) = "topmem"      alias (CoreTemp   _ _) = "coretemp"      alias (DiskU    _ _ _) = "disku" @@ -98,4 +98,4 @@ instance Exec Monitors where      start (DiskU    s a r) = runM a          diskUConfig   (runDiskU s)   r      start (DiskIO   s a r) = runM a          diskIOConfig  (runDiskIO s)  r      start (TopMem     a r) = runM a          topMemConfig   runTopMem     r -    start (TopCpu     a r) = startTopCpu a r +    start (TopProc    a r) = startTop a r diff --git a/Plugins/Monitors/Mem.hs b/Plugins/Monitors/Mem.hs index c6c4dc4..f493862 100644 --- a/Plugins/Monitors/Mem.hs +++ b/Plugins/Monitors/Mem.hs @@ -12,7 +12,7 @@  --  ----------------------------------------------------------------------------- -module Plugins.Monitors.Mem where +module Plugins.Monitors.Mem (memConfig, runMem, totalMem, usedMem) where  import Plugins.Monitors.Common @@ -35,18 +35,24 @@ parseMEM =             usedratio = used / total         return [usedratio, total, free, buffer, cache, rest, used] +totalMem :: IO Float +totalMem = fmap ((*1024) . (!!1)) parseMEM + +usedMem :: IO Float +usedMem = fmap ((*1024) . (!!6)) parseMEM +  formatMem :: [Float] -> Monitor [String]  formatMem (r:xs) = -    do let f n = showDigits 0 n +    do let f = showDigits 0             rr = 100 * r         ub <- showPercentBar rr r         fb <- showPercentBar (100 - rr) (1 - r)         s <- mapM (showWithColors f) (rr:xs)         return (ub:fb:s) -formatMem _ = return $ replicate 8 "N/A" +formatMem _ = return $ replicate 9 "N/A"  runMem :: [String] -> Monitor String  runMem _ = -    do m <- io $ parseMEM +    do m <- io parseMEM         l <- formatMem m         parseTemplate l diff --git a/Plugins/Monitors/Top.hs b/Plugins/Monitors/Top.hs index 779cfbe..02f42ff 100644 --- a/Plugins/Monitors/Top.hs +++ b/Plugins/Monitors/Top.hs @@ -14,9 +14,10 @@  {-# LANGUAGE ForeignFunctionInterface, BangPatterns #-} -module Plugins.Monitors.Top (startTopCpu, topMemConfig, runTopMem) where +module Plugins.Monitors.Top (startTop, topMemConfig, runTopMem) where  import Plugins.Monitors.Common +import Plugins.Monitors.Mem (usedMem)  import Control.Exception (SomeException, handle, evaluate)  import System.Directory @@ -35,11 +36,12 @@ import qualified Data.IntMap as M  topMemConfig :: IO MConfig  topMemConfig = mkMConfig "<both1>" [ k ++ n | n <- map show [1..maxProc] -                                            , k <- ["name", "rss", "both"]] +                                            , k <- ["name", "mem", "both"]] -topCpuConfig :: IO MConfig -topCpuConfig = mkMConfig "<both1>" [ k ++ n | n <- map show [1..maxProc] -                                            , k <- ["name", "cpu", "both"]] +topConfig :: IO MConfig +topConfig = mkMConfig "<both1>" [ k ++ n | n <- map show [1..maxProc] +                                         , k <- [ "name", "cpu", "both" +                                                , "mname", "mem", "mboth"]] @@ -61,23 +63,11 @@ showInfo nm sms mms = do    both <- showWithColors' (rnm ++ " " ++ sms) mms    return [nm, mstr, both] -strictReadFile :: FilePath -> IO String -strictReadFile f = -  do hdl <- openFile f ReadMode -     xs <- getc hdl -     hClose hdl -     return xs -    where getc hdl = do e <- hIsEOF hdl -                        if e then return [] -                          else do c <- hGetChar hdl -                                  cs <- getc hdl -                                  return (c:cs) -  getProcessData :: FilePath -> IO [String]  getProcessData pidf =    handle ((\_ -> evaluate []) :: SomeException -> IO [String]) -         (do s <- strictReadFile $ "/proc" </> pidf </> "stat" -             evaluate $! words s) +         (withFile ("/proc" </> pidf </> "stat") ReadMode readWords) +  where readWords = fmap words . hGetLine  processes :: IO [FilePath]  processes = fmap (filter isPid) (getDirectoryContents "/proc") @@ -109,16 +99,16 @@ topMemProcesses :: Int -> IO [Meminfo]  topMemProcesses n = fmap (take n . sbm) meminfos    where sbm = sortBy (flip (comparing snd)) -showMeminfo :: Meminfo -> Monitor [String] -showMeminfo (nm, rss) = -  showInfo nm sms (ms / 1024) +showMeminfo :: Float -> Meminfo -> Monitor [String] +showMeminfo scale (nm, rss) = +  showInfo nm sms (ms / (1024 * scale))      where ms = fromIntegral rss            sms = showWithUnits 2 1 ms  runTopMem :: [String] -> Monitor String  runTopMem _ = do    ps <- io $ topMemProcesses maxProc -  pstr <- mapM showMeminfo ps +  pstr <- mapM (showMeminfo 1) ps    parseTemplate $ concat pstr  type Pid = Int @@ -127,47 +117,53 @@ type TimeEntry = (Pid, TimeInfo)  type Times = IntMap TimeInfo  type TimesRef = IORef (Times, UTCTime) -timeEntry :: [String] -> TimeEntry -timeEntry fs = (p, (n, t)) +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 = pageSize * read (fs!!23) -timeEntries :: IO [TimeEntry] -timeEntries = handleProcesses (0, ("", 0)) timeEntry +timeMemEntries :: IO [(TimeEntry, Meminfo)] +timeMemEntries = handleProcesses ((0, ("", 0)), ("", 0)) timeMemEntry -timeinfos :: IO Times -timeinfos = fmap M.fromList timeEntries +timeMemInfos :: IO (Times, [Meminfo]) +timeMemInfos = +  fmap (\x -> (M.fromList . map fst $ x, map snd x)) timeMemEntries  combineTimeInfos :: Times -> Times -> Times  combineTimeInfos !t0 !t1 = M.intersectionWith timeDiff t1 t0 -  where timeDiff (n, x1) (_, x0) = (n, x1 - x0) +  where timeDiff (n, x1) (_, x0) = let !d = x1 - x0 in (n, d) -topTimeProcesses :: Int -> TimesRef -> Float -> IO [TimeInfo] -topTimeProcesses n tref scale = do -  !c1 <- getCurrentTime -  !t1 <- timeinfos +topProcesses :: Int -> TimesRef -> Float -> IO ([TimeInfo], [Meminfo]) +topProcesses n tref scale = do +  c1 <- getCurrentTime +  (t1, mi) <- timeMemInfos    (t0, c0) <- readIORef tref -  modifyIORef tref (const $! (t1, c1)) -  let !ts = M.elems $ combineTimeInfos t0 t1 -      !sts = take n $ sortBy (flip (comparing snd)) ts -      !nts = map norm sts -      !scx = (fromRational . toRational $! diffUTCTime c1 c0) * scale / 100 +  writeIORef tref (t1, c1) +  let ts = M.elems $ combineTimeInfos t0 t1 +      sts = take n $ sortBy (flip (comparing snd)) ts +      nts = map norm sts +      scx = (fromRational . toRational $! diffUTCTime c1 c0) * scale / 100        norm (nm, t) = (nm, t / scx) -  return nts +      mis = take n (sbm mi) +      sbm = sortBy (flip (comparing snd)) +  return (nts, mis)  showTimeInfo :: TimeInfo -> Monitor [String]  showTimeInfo (n, t) = showInfo n (showDigits 1 t) t -runTopCpu :: TimesRef -> Float -> [String] -> Monitor String -runTopCpu tref scale _ = do -   ps <- io $ topTimeProcesses maxProc tref scale -   pstr <- mapM showTimeInfo ps -   parseTemplate $ concat pstr +runTop :: TimesRef -> Float -> Float -> [String] -> Monitor String +runTop tref scale mscale _ = do +  (ps, ms) <- io $ topProcesses maxProc tref scale +  pstr <- mapM showTimeInfo ps +  mstr <- mapM (showMeminfo mscale) ms +  parseTemplate $ concat $ zipWith (++) pstr mstr -startTopCpu :: [String] -> Int -> (String -> IO ()) -> IO () -startTopCpu a r cb = do +startTop :: [String] -> Int -> (String -> IO ()) -> IO () +startTop a r cb = do    cr <- getSysVar ClockTick +  m <- usedMem    c <- getCurrentTime    tref <- newIORef (M.empty, c) -  runM a topCpuConfig (runTopCpu tref (fromIntegral cr)) r cb +  runM a topConfig (runTop tref (fromIntegral cr) m) r cb | 
