summaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
-rw-r--r--Plugins/Monitors/StatFS.hsc9
-rw-r--r--Plugins/Monitors/Top.hs78
2 files changed, 53 insertions, 34 deletions
diff --git a/Plugins/Monitors/StatFS.hsc b/Plugins/Monitors/StatFS.hsc
index ad3b659..9c1972c 100644
--- a/Plugins/Monitors/StatFS.hsc
+++ b/Plugins/Monitors/StatFS.hsc
@@ -15,12 +15,12 @@
{-# LANGUAGE CPP, ForeignFunctionInterface, EmptyDataDecls #-}
-module Plugins.Monitors.StatFS (FileSystemStats(..), getFileSystemStats) where
+module Plugins.Monitors.StatFS ( FileSystemStats(..)
+ , getFileSystemStats ) where
import Foreign
import Foreign.C.Types
import Foreign.C.String
-import Foreign.Storable
import Data.ByteString (useAsCString)
import Data.ByteString.Char8 (pack)
@@ -54,9 +54,8 @@ getFileSystemStats path =
allocaBytes (#size struct statfs) $ \vfs ->
useAsCString (pack path) $ \cpath -> do
res <- c_statfs cpath vfs
- case res of
- -1 -> return Nothing
- _ -> do
+ if res == -1 then return Nothing
+ else do
bsize <- (#peek struct statfs, f_bsize) vfs
bcount <- (#peek struct statfs, f_blocks) vfs
bfree <- (#peek struct statfs, f_bfree) vfs
diff --git a/Plugins/Monitors/Top.hs b/Plugins/Monitors/Top.hs
index 38686f6..6ca75c7 100644
--- a/Plugins/Monitors/Top.hs
+++ b/Plugins/Monitors/Top.hs
@@ -21,6 +21,7 @@ import Plugins.Monitors.Common
import Control.Exception (SomeException, handle, evaluate)
import System.Directory
import System.FilePath
+import System.IO
import System.Posix.Unistd (getSysVar, SysVar(ClockTick))
import Foreign.C.Types
import Data.List (sortBy)
@@ -40,19 +41,13 @@ topCpuConfig = mkMConfig "<both1>" [ k ++ n | n <- map show [1..maxProc]
, k <- ["name", "cpu", "both"]]
+
foreign import ccall "unistd.h getpagesize"
c_getpagesize :: CInt
pageSize :: Int
pageSize = fromIntegral c_getpagesize `div` 1024
-processes :: IO [FilePath]
-processes =
- fmap (filter isPid) $ getDirectoryContents "/proc"
- where
- isPid (x:_) = x `elem` ['0'..'9']
- isPid _ = False
-
showInfo :: String -> String -> Float -> Monitor [String]
showInfo nm sms mms = do
mnw <- getConfigValue maxWidth
@@ -65,29 +60,53 @@ showInfo nm sms mms = do
both <- showWithColors' (rnm ++ " " ++ sms) mms
return [nm, mstr, both]
-defHandle :: a -> SomeException -> IO a
-defHandle def _ = evaluate def
+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)
-handlePidFile :: a -> ([String] -> IO a) -> FilePath -> IO a
-handlePidFile def action pidf =
- handle (defHandle def) (fmap words (readFile f) >>= action)
- where f = "/proc" </> pidf </> "stat"
+processes :: IO [FilePath]
+processes = do
+ fs <- getDirectoryContents "/proc"
+ return $! filter isPid $! fs
+ where
+ isPid (x:_) = x `elem` ['0'..'9']
+ isPid _ = False
+
+handleProcesses :: a -> ([String] -> a) -> IO [a]
+handleProcesses def f = do
+ ps <- processes
+ pd <- mapM getProcessData $! ps
+ return $! map (\x -> if x == [] then def else f x) pd
+
+processName :: [String] -> String
+processName = drop 1 . init . (!!1)
maxProc :: Int
maxProc = 5
type Meminfo = (String, Int)
-meminfo :: FilePath -> IO Meminfo
-meminfo = handlePidFile ("", 0) $ \fs ->
- let !m = pageSize * read (fs !! 23)
- !n = drop 1 $ init (fs !! 1)
- in evaluate (n, m)
+meminfo :: [String] -> Meminfo
+meminfo fs = (n, r)
+ where !n = processName fs
+ !r = pageSize * (read (fs!!23))
meminfos :: IO [Meminfo]
-meminfos = do
- fs <- processes
- mapM meminfo fs
+meminfos = handleProcesses ("", 0) meminfo
topMemProcesses :: Int -> IO [Meminfo]
topMemProcesses n = fmap (take n . sbm) meminfos
@@ -111,16 +130,17 @@ type TimeEntry = (Pid, TimeInfo)
type Times = IntMap TimeInfo
type TimesRef = IORef Times
-timeEntry :: FilePath -> IO TimeEntry
-timeEntry = 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))
+timeEntry :: [String] -> TimeEntry
+timeEntry fs = (p, (n, t))
+ where !p = read (head fs)
+ !n = processName fs
+ !t = read (fs!!13) + read (fs!!14)
+
+timeEntries :: IO [TimeEntry]
+timeEntries = handleProcesses (0, ("", 0)) timeEntry
timeinfos :: IO Times
-timeinfos = fmap M.fromList (processes >>= mapM timeEntry)
+timeinfos = fmap M.fromList timeEntries
combineTimeInfos :: Times -> Times -> Times
combineTimeInfos !t0 !t1 = M.intersectionWith timeDiff t1 t0