{-#LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
module Xmobar.Plugins.Monitors.Top (startTop, topMemConfig, runTopMem) where
import Xmobar.Plugins.Monitors.Common
import Data.IORef (newIORef, readIORef, writeIORef)
import Data.List (sortBy)
import Data.Ord (comparing, Down (..))
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
maxEntries :: Int
maxEntries :: Pid
maxEntries = Pid
10
intStrs :: [String]
intStrs :: [String]
intStrs = (Pid -> String) -> [Pid] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Pid -> String
forall a. Show a => a -> String
show [Pid
1..Pid
maxEntries]
topMemConfig :: IO MConfig
topMemConfig :: IO MConfig
topMemConfig = String -> [String] -> IO MConfig
mkMConfig String
"<both1>"
[ String
k String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n | String
n <- [String]
intStrs , String
k <- [String
"name", String
"mem", String
"both"]]
topConfig :: IO MConfig
topConfig :: IO MConfig
topConfig = String -> [String] -> IO MConfig
mkMConfig String
"<both1>"
(String
"no" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [ String
k String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n | String
n <- [String]
intStrs
, String
k <- [ String
"name", String
"cpu", String
"both"
, String
"mname", String
"mem", String
"mboth"]])
showInfo :: String -> String -> Float -> Monitor [String]
showInfo :: String -> String -> Float -> Monitor [String]
showInfo String
nm String
sms Float
mms = do
mnw <- Selector Pid -> Monitor Pid
forall a. Selector a -> Monitor a
getConfigValue Selector Pid
maxWidth
mxw <- getConfigValue minWidth
let lsms = String -> Pid
forall a. [a] -> Pid
forall (t :: * -> *) a. Foldable t => t a -> Pid
length String
sms
nmw = Pid
mnw Pid -> Pid -> Pid
forall a. Num a => a -> a -> a
- Pid
lsms Pid -> Pid -> Pid
forall a. Num a => a -> a -> a
- Pid
1
nmx = Pid
mxw Pid -> Pid -> Pid
forall a. Num a => a -> a -> a
- Pid
lsms Pid -> Pid -> Pid
forall a. Num a => a -> a -> a
- Pid
1
rnm = if Pid
nmw Pid -> Pid -> Bool
forall a. Ord a => a -> a -> Bool
> Pid
0 then Pid -> Pid -> String -> Bool -> String -> String -> String
padString Pid
nmw Pid
nmx String
" " Bool
True String
"" String
nm else String
nm
mstr <- showWithColors' sms mms
both <- showWithColors' (rnm ++ " " ++ sms) mms
return [nm, mstr, both]
sortTop :: [(String, Float)] -> [(String, Float)]
sortTop :: [(String, Float)] -> [(String, Float)]
sortTop = ((String, Float) -> (String, Float) -> Ordering)
-> [(String, Float)] -> [(String, Float)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((String, Float) -> Down Float)
-> (String, Float) -> (String, Float) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Float -> Down Float
forall a. a -> Down a
Down (Float -> Down Float)
-> ((String, Float) -> Float) -> (String, Float) -> Down Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Float) -> Float
forall a b. (a, b) -> b
snd))
showMemInfo :: Float -> MemInfo -> Monitor [String]
showMemInfo :: Float -> (String, Float) -> Monitor [String]
showMemInfo Float
scale (String
nm, Float
rss) =
String -> String -> Float -> Monitor [String]
showInfo String
nm (Pid -> Pid -> Float -> String
showWithUnits Pid
3 Pid
1 Float
rss) (Float
100 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
rss Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
sc)
where sc :: Float
sc = if Float
scale Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0 then Float
scale else Float
100
showMemInfos :: [MemInfo] -> Monitor [[String]]
showMemInfos :: [(String, Float)] -> Monitor [[String]]
showMemInfos [(String, Float)]
ms = ((String, Float) -> Monitor [String])
-> [(String, Float)] -> Monitor [[String]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Float -> (String, Float) -> Monitor [String]
showMemInfo Float
tm) [(String, Float)]
ms
where tm :: Float
tm = [Float] -> Float
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (((String, Float) -> Float) -> [(String, Float)] -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map (String, Float) -> Float
forall a b. (a, b) -> b
snd [(String, Float)]
ms)
timeMemInfos :: IO (Times, [MemInfo], Int)
timeMemInfos :: IO (Times, [(String, Float)], Pid)
timeMemInfos = ([((Pid, (String, Float)), (String, Float))]
-> (Times, [(String, Float)], Pid))
-> IO [((Pid, (String, Float)), (String, Float))]
-> IO (Times, [(String, Float)], Pid)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [((Pid, (String, Float)), (String, Float))]
-> (Times, [(String, Float)], Pid)
forall {a} {b} {b}. Ord a => [((a, b), b)] -> ([(a, b)], [b], Pid)
res IO [((Pid, (String, Float)), (String, Float))]
MT.timeMemEntries
where res :: [((a, b), b)] -> ([(a, b)], [b], Pid)
res [((a, b), b)]
x = (((a, b) -> (a, b) -> Ordering) -> [(a, b)] -> [(a, b)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((a, b) -> a) -> (a, b) -> (a, b) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (a, b) -> a
forall a b. (a, b) -> a
fst) ([(a, b)] -> [(a, b)]) -> [(a, b)] -> [(a, b)]
forall a b. (a -> b) -> a -> b
$ (((a, b), b) -> (a, b)) -> [((a, b), b)] -> [(a, b)]
forall a b. (a -> b) -> [a] -> [b]
map ((a, b), b) -> (a, b)
forall a b. (a, b) -> a
fst [((a, b), b)]
x, (((a, b), b) -> b) -> [((a, b), b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map ((a, b), b) -> b
forall a b. (a, b) -> b
snd [((a, b), b)]
x, [((a, b), b)] -> Pid
forall a. [a] -> Pid
forall (t :: * -> *) a. Foldable t => t a -> Pid
length [((a, b), b)]
x)
combine :: Times -> Times -> Times
combine :: Times -> Times -> Times
combine Times
_ [] = []
combine [] Times
ts = Times
ts
combine l :: Times
l@((Pid
p0, (String
n0, Float
t0)):Times
ls) r :: Times
r@((Pid
p1, (String
n1, Float
t1)):Times
rs)
| Pid
p0 Pid -> Pid -> Bool
forall a. Eq a => a -> a -> Bool
== Pid
p1 Bool -> Bool -> Bool
&& String
n0 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
n1 = (Pid
p0, (String
n0, Float
t1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
t0)) (Pid, (String, Float)) -> Times -> Times
forall a. a -> [a] -> [a]
: Times -> Times -> Times
combine Times
ls Times
rs
| Pid
p0 Pid -> Pid -> Bool
forall a. Ord a => a -> a -> Bool
<= Pid
p1 = Times -> Times -> Times
combine Times
ls Times
r
| Bool
otherwise = (Pid
p1, (String
n1, Float
t1)) (Pid, (String, Float)) -> Times -> Times
forall a. a -> [a] -> [a]
: Times -> Times -> Times
combine Times
l Times
rs
take' :: Int -> [a] -> [a]
take' :: forall a. Pid -> [a] -> [a]
take' Pid
m [a]
l = let !r :: [a]
r = Pid -> [a] -> [a]
forall {a} {a}. (Eq a, Num a) => a -> [a] -> [a]
tk Pid
m [a]
l in [a] -> Pid
forall a. [a] -> Pid
forall (t :: * -> *) a. Foldable t => t a -> Pid
length [a]
l Pid -> [a] -> [a]
forall a b. a -> b -> b
`seq` [a]
r
where tk :: a -> [a] -> [a]
tk a
0 [a]
_ = []
tk a
_ [] = []
tk a
n (a
x:[a]
xs) = let !r :: [a]
r = a -> [a] -> [a]
tk (a
n a -> a -> a
forall a. Num a => a -> a -> a
- a
1) [a]
xs in a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
r
topProcesses :: TimesRef -> Float -> IO (Int, [TimeInfo], [MemInfo])
topProcesses :: TimesRef -> Float -> IO (Pid, [(String, Float)], [(String, Float)])
topProcesses TimesRef
tref Float
scale = do
(t0, c0) <- TimesRef -> IO (Times, UTCTime)
forall a. IORef a -> IO a
readIORef TimesRef
tref
(t1, mis, len) <- timeMemInfos
c1 <- getCurrentTime
let scx = NominalDiffTime -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac (UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
c1 UTCTime
c0) Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
scale
!scx' = if Float
scx Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0 then Float
scx else Float
scale
nts = ((Pid, (String, Float)) -> (String, Float))
-> Times -> [(String, Float)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Pid
_, (String
nm, Float
t)) -> (String
nm, Float
t Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
scx')) (Times -> Times -> Times
combine Times
t0 Times
t1)
!t1' = Pid -> Times -> Times
forall a. Pid -> [a] -> [a]
take' (Times -> Pid
forall a. [a] -> Pid
forall (t :: * -> *) a. Foldable t => t a -> Pid
length Times
t1) Times
t1
!nts' = Pid -> [(String, Float)] -> [(String, Float)]
forall a. Pid -> [a] -> [a]
take' Pid
maxEntries ([(String, Float)] -> [(String, Float)]
sortTop [(String, Float)]
nts)
!mis' = Pid -> [(String, Float)] -> [(String, Float)]
forall a. Pid -> [a] -> [a]
take' Pid
maxEntries ([(String, Float)] -> [(String, Float)]
sortTop [(String, Float)]
mis)
writeIORef tref (t1', c1)
return (len, nts', mis')
showTimeInfo :: TimeInfo -> Monitor [String]
showTimeInfo :: (String, Float) -> Monitor [String]
showTimeInfo (String
n, Float
t) =
Selector Pid -> Monitor Pid
forall a. Selector a -> Monitor a
getConfigValue Selector Pid
decDigits Monitor Pid -> (Pid -> Monitor [String]) -> Monitor [String]
forall a b.
ReaderT MConfig IO a
-> (a -> ReaderT MConfig IO b) -> ReaderT MConfig IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Pid
d -> String -> String -> Float -> Monitor [String]
showInfo String
n (Pid -> Float -> String
forall a. RealFloat a => Pid -> a -> String
showDigits Pid
d Float
t) Float
t
showTimeInfos :: [TimeInfo] -> Monitor [[String]]
showTimeInfos :: [(String, Float)] -> Monitor [[String]]
showTimeInfos = ((String, Float) -> Monitor [String])
-> [(String, Float)] -> Monitor [[String]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (String, Float) -> Monitor [String]
showTimeInfo
runTopMem :: [String] -> Monitor String
runTopMem :: [String] -> Monitor String
runTopMem [String]
_ = do
mis <- IO [(String, Float)] -> Monitor [(String, Float)]
forall a. IO a -> Monitor a
io IO [(String, Float)]
MT.meminfos
pstr <- showMemInfos (sortTop mis)
parseTemplate $ concat pstr
runTop :: TimesRef -> Float -> [String] -> Monitor String
runTop :: TimesRef -> Float -> [String] -> Monitor String
runTop TimesRef
tref Float
scale [String]
_ = do
(no, ps, ms) <- IO (Pid, [(String, Float)], [(String, Float)])
-> Monitor (Pid, [(String, Float)], [(String, Float)])
forall a. IO a -> Monitor a
io (IO (Pid, [(String, Float)], [(String, Float)])
-> Monitor (Pid, [(String, Float)], [(String, Float)]))
-> IO (Pid, [(String, Float)], [(String, Float)])
-> Monitor (Pid, [(String, Float)], [(String, Float)])
forall a b. (a -> b) -> a -> b
$ TimesRef -> Float -> IO (Pid, [(String, Float)], [(String, Float)])
topProcesses TimesRef
tref Float
scale
pstr <- showTimeInfos ps
mstr <- showMemInfos ms
na <- getConfigValue naString
parseTemplate $ show no : concat (zipWith (++) pstr mstr) ++ repeat na
startTop :: [String] -> Int -> (String -> IO ()) -> IO ()
startTop :: [String] -> Pid -> (String -> IO ()) -> IO ()
startTop [String]
a Pid
r String -> IO ()
cb = do
c <- IO UTCTime
getCurrentTime
tref <- newIORef ([], c)
scale <- MT.scale
_ <- topProcesses tref scale
runM a topConfig (runTop tref scale) r cb