From 8287e45b62d0d310512574850bad4741c4b3a53d Mon Sep 17 00:00:00 2001 From: Michal Zielonka Date: Mon, 11 Oct 2021 23:11:30 +0200 Subject: add top for freebsd proc In FreeBSD /proc/pid/stat is missing we should use for top procstat library. --- src/Xmobar/Plugins/Monitors/Top/Linux.hs | 92 ++++++++++++++++++++++++++++++++ 1 file changed, 92 insertions(+) create mode 100644 src/Xmobar/Plugins/Monitors/Top/Linux.hs (limited to 'src/Xmobar/Plugins/Monitors/Top/Linux.hs') diff --git a/src/Xmobar/Plugins/Monitors/Top/Linux.hs b/src/Xmobar/Plugins/Monitors/Top/Linux.hs new file mode 100644 index 0000000..715a7cd --- /dev/null +++ b/src/Xmobar/Plugins/Monitors/Top/Linux.hs @@ -0,0 +1,92 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Plugins.Monitors.Top.Linux +-- Copyright : (c) 2010, 2011, 2012, 2013, 2014, 2018 Jose A Ortega Ruiz +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Jose A Ortega Ruiz +-- Stability : unstable +-- Portability : unportable +-- +-- Process activity and memory consumption monitors +-- +----------------------------------------------------------------------------- + +{-# LANGUAGE ForeignFunctionInterface #-} + +module Xmobar.Plugins.Monitors.Top.Linux ( + timeMemEntries + , meminfos + , scale) where + +import Xmobar.Plugins.Monitors.Common (parseFloat, parseInt) +import Xmobar.Plugins.Monitors.Top.Common (MemInfo, TimeEntry) + +import Control.Exception (SomeException, handle) +import Data.List (foldl') +import System.Directory (getDirectoryContents) +import System.FilePath (()) +import System.IO (IOMode(ReadMode), hGetLine, withFile) +import System.Posix.Unistd (SysVar(ClockTick), getSysVar) + +import Foreign.C.Types + +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) + +processName :: [String] -> String +processName = drop 1 . init . (!!1) + +meminfo :: [String] -> MemInfo +meminfo fs = (processName fs, pageSize * parseFloat (fs!!23)) + +meminfos :: IO [MemInfo] +meminfos = handleProcesses meminfo + +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 + + +scale :: IO Float +scale = do + cr <- getSysVar ClockTick + return $ fromIntegral cr / 100 -- cgit v1.2.3