summaryrefslogtreecommitdiffhomepage
path: root/src/Xmobar/Plugins/Monitors/Top.hs
diff options
context:
space:
mode:
authorMichal Zielonka <michal.zielonka.8001@gmail.com>2021-10-11 23:11:30 +0200
committerMichal Zielonka <michal.zielonka.8001@gmail.com>2021-10-16 22:55:38 +0200
commit8287e45b62d0d310512574850bad4741c4b3a53d (patch)
treef38dd0fb2fd2f31d3482fe7f2d86cfdeb1cb70db /src/Xmobar/Plugins/Monitors/Top.hs
parent82127e302355ceebfc3022d63823ed5789a69f9c (diff)
downloadxmobar-8287e45b62d0d310512574850bad4741c4b3a53d.tar.gz
xmobar-8287e45b62d0d310512574850bad4741c4b3a53d.tar.bz2
add top for freebsd proc
In FreeBSD /proc/pid/stat is missing we should use for top procstat library.
Diffstat (limited to 'src/Xmobar/Plugins/Monitors/Top.hs')
-rw-r--r--src/Xmobar/Plugins/Monitors/Top.hs109
1 files changed, 26 insertions, 83 deletions
diff --git a/src/Xmobar/Plugins/Monitors/Top.hs b/src/Xmobar/Plugins/Monitors/Top.hs
index d6df249..e99ec3b 100644
--- a/src/Xmobar/Plugins/Monitors/Top.hs
+++ b/src/Xmobar/Plugins/Monitors/Top.hs
@@ -1,3 +1,5 @@
+{-#LANGUAGE CPP #-}
+{-# LANGUAGE BangPatterns #-}
-----------------------------------------------------------------------------
-- |
-- Module : Plugins.Monitors.Top
@@ -12,24 +14,27 @@
--
-----------------------------------------------------------------------------
-{-# LANGUAGE ForeignFunctionInterface #-}
-{-# LANGUAGE BangPatterns #-}
-
module Xmobar.Plugins.Monitors.Top (startTop, topMemConfig, runTopMem) where
import Xmobar.Plugins.Monitors.Common
-import Control.Exception (SomeException, handle)
-import Data.IORef (IORef, newIORef, readIORef, writeIORef)
-import Data.List (sortBy, foldl')
+import Data.IORef (newIORef, readIORef, writeIORef)
+import Data.List (sortBy)
import Data.Ord (comparing)
-import Data.Time.Clock (UTCTime, getCurrentTime, diffUTCTime)
-import System.Directory (getDirectoryContents)
-import System.FilePath ((</>))
-import System.IO (IOMode(ReadMode), hGetLine, withFile)
-import System.Posix.Unistd (SysVar(ClockTick), getSysVar)
+import Data.Time.Clock (getCurrentTime, diffUTCTime)
+
+import Xmobar.Plugins.Monitors.Top.Common (
+ MemInfo
+ , TimeInfo
+ , Times
+ , TimesRef)
+
+#if defined(freebsd_HOST_OS)
+import qualified Xmobar.Plugins.Monitors.Top.FreeBSD as MT
+#else
+import qualified Xmobar.Plugins.Monitors.Top.Linux as MT
+#endif
-import Foreign.C.Types
maxEntries :: Int
maxEntries = 10
@@ -47,41 +52,6 @@ topConfig = mkMConfig "<both1>"
, k <- [ "name", "cpu", "both"
, "mname", "mem", "mboth"]])
-foreign import ccall "unistd.h getpagesize"
- c_getpagesize :: CInt
-
-pageSize :: Float
-pageSize = fromIntegral c_getpagesize / 1024
-
-processes :: IO [FilePath]
-processes = fmap (filter isPid) (getDirectoryContents "/proc")
- where isPid = (`elem` ['0'..'9']) . head
-
-statWords :: [String] -> [String]
-statWords line@(x:pn:ppn:xs) =
- if last pn == ')' then line else statWords (x:(pn ++ " " ++ ppn):xs)
-statWords _ = replicate 52 "0"
-
-getProcessData :: FilePath -> IO [String]
-getProcessData pidf =
- handle ign $ withFile ("/proc" </> pidf </> "stat") ReadMode readWords
- where readWords = fmap (statWords . words) . hGetLine
- ign = const (return []) :: SomeException -> IO [String]
-
-memPages :: [String] -> String
-memPages fs = fs!!23
-
-ppid :: [String] -> String
-ppid fs = fs!!3
-
-skip :: [String] -> Bool
-skip fs = length fs < 24 || memPages fs == "0" || ppid fs == "0"
-
-handleProcesses :: ([String] -> a) -> IO [a]
-handleProcesses f =
- fmap (foldl' (\a p -> if skip p then a else f p : a) [])
- (processes >>= mapM getProcessData)
-
showInfo :: String -> String -> Float -> Monitor [String]
showInfo nm sms mms = do
mnw <- getConfigValue maxWidth
@@ -94,20 +64,10 @@ showInfo nm sms mms = do
both <- showWithColors' (rnm ++ " " ++ sms) mms
return [nm, mstr, both]
-processName :: [String] -> String
-processName = drop 1 . init . (!!1)
sortTop :: [(String, Float)] -> [(String, Float)]
sortTop = sortBy (flip (comparing snd))
-type MemInfo = (String, Float)
-
-meminfo :: [String] -> MemInfo
-meminfo fs = (processName fs, pageSize * parseFloat (fs!!23))
-
-meminfos :: IO [MemInfo]
-meminfos = handleProcesses meminfo
-
showMemInfo :: Float -> MemInfo -> Monitor [String]
showMemInfo scale (nm, rss) =
showInfo nm (showWithUnits 3 1 rss) (100 * rss / sc)
@@ -117,30 +77,8 @@ showMemInfos :: [MemInfo] -> Monitor [[String]]
showMemInfos ms = mapM (showMemInfo tm) ms
where tm = sum (map snd ms)
-runTopMem :: [String] -> Monitor String
-runTopMem _ = do
- mis <- io meminfos
- pstr <- showMemInfos (sortTop mis)
- parseTemplate $ concat pstr
-
-type Pid = Int
-type TimeInfo = (String, Float)
-type TimeEntry = (Pid, TimeInfo)
-type Times = [TimeEntry]
-type TimesRef = IORef (Times, UTCTime)
-
-timeMemEntry :: [String] -> (TimeEntry, MemInfo)
-timeMemEntry fs = ((p, (n, t)), (n, r))
- where p = parseInt (head fs)
- n = processName fs
- t = parseFloat (fs!!13) + parseFloat (fs!!14)
- (_, r) = meminfo fs
-
-timeMemEntries :: IO [(TimeEntry, MemInfo)]
-timeMemEntries = handleProcesses timeMemEntry
-
timeMemInfos :: IO (Times, [MemInfo], Int)
-timeMemInfos = fmap res timeMemEntries
+timeMemInfos = fmap res MT.timeMemEntries
where res x = (sortBy (comparing fst) $ map fst x, map snd x, length x)
combine :: Times -> Times -> Times
@@ -164,7 +102,7 @@ topProcesses tref scale = do
c1 <- getCurrentTime
let scx = realToFrac (diffUTCTime c1 c0) * scale
!scx' = if scx > 0 then scx else scale
- nts = map (\(_, (nm, t)) -> (nm, min 100 (t / scx'))) (combine t0 t1)
+ nts = map (\(_, (nm, t)) -> (nm, t / scx')) (combine t0 t1)
!t1' = take' (length t1) t1
!nts' = take' maxEntries (sortTop nts)
!mis' = take' maxEntries (sortTop mis)
@@ -178,6 +116,12 @@ showTimeInfo (n, t) =
showTimeInfos :: [TimeInfo] -> Monitor [[String]]
showTimeInfos = mapM showTimeInfo
+runTopMem :: [String] -> Monitor String
+runTopMem _ = do
+ mis <- io MT.meminfos
+ pstr <- showMemInfos (sortTop mis)
+ parseTemplate $ concat pstr
+
runTop :: TimesRef -> Float -> [String] -> Monitor String
runTop tref scale _ = do
(no, ps, ms) <- io $ topProcesses tref scale
@@ -187,9 +131,8 @@ runTop tref scale _ = do
startTop :: [String] -> Int -> (String -> IO ()) -> IO ()
startTop a r cb = do
- cr <- getSysVar ClockTick
c <- getCurrentTime
tref <- newIORef ([], c)
- let scale = fromIntegral cr / 100
+ scale <- MT.scale
_ <- topProcesses tref scale
runM a topConfig (runTop tref scale) r cb