{-#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)
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 :: Int
maxEntries = Int
10
intStrs :: [String]
intStrs :: [String]
intStrs = (Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Int -> String
forall a. Show a => a -> String
show [Int
1..Int
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
Int
mnw <- Selector Int -> Monitor Int
forall a. Selector a -> Monitor a
getConfigValue Selector Int
maxWidth
Int
mxw <- Selector Int -> Monitor Int
forall a. Selector a -> Monitor a
getConfigValue Selector Int
minWidth
let lsms :: Int
lsms = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
sms
nmw :: Int
nmw = Int
mnw Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lsms Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
nmx :: Int
nmx = Int
mxw Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lsms Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
rnm :: String
rnm = if Int
nmw Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Int -> Int -> String -> Bool -> String -> String -> String
padString Int
nmw Int
nmx String
" " Bool
True String
"" String
nm else String
nm
String
mstr <- String -> Float -> Monitor String
forall a. (Num a, Ord a) => String -> a -> Monitor String
showWithColors' String
sms Float
mms
String
both <- String -> Float -> Monitor String
forall a. (Num a, Ord a) => String -> a -> Monitor String
showWithColors' (String
rnm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sms) Float
mms
[String] -> Monitor [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String
nm, String
mstr, String
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) -> (String, Float) -> Ordering)
-> (String, Float) -> (String, Float) -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip (((String, Float) -> Float)
-> (String, Float) -> (String, Float) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (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 (Int -> Int -> Float -> String
showWithUnits Int
3 Int
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)
mapM (Float -> (String, Float) -> Monitor [String]
showMemInfo Float
tm) [(String, Float)]
ms
where tm :: Float
tm = [Float] -> Float
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)], Int)
timeMemInfos = ([((Int, (String, Float)), (String, Float))]
-> (Times, [(String, Float)], Int))
-> IO [((Int, (String, Float)), (String, Float))]
-> IO (Times, [(String, Float)], Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [((Int, (String, Float)), (String, Float))]
-> (Times, [(String, Float)], Int)
forall a b b. Ord a => [((a, b), b)] -> ([(a, b)], [b], Int)
res IO [((Int, (String, Float)), (String, Float))]
MT.timeMemEntries
where res :: [((a, b), b)] -> ([(a, b)], [b], Int)
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)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [((a, b), b)]
x)
combine :: Times -> Times -> Times
combine :: Times -> Times -> Times
combine Times
_ [] = []
combine [] Times
ts = Times
ts
combine l :: Times
l@((Int
p0, (String
n0, Float
t0)):Times
ls) r :: Times
r@((Int
p1, (String
n1, Float
t1)):Times
rs)
| Int
p0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
p1 Bool -> Bool -> Bool
&& String
n0 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
n1 = (Int
p0, (String
n0, Float
t1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
t0)) (Int, (String, Float)) -> Times -> Times
forall a. a -> [a] -> [a]
: Times -> Times -> Times
combine Times
ls Times
rs
| Int
p0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
p1 = Times -> Times -> Times
combine Times
ls Times
r
| Bool
otherwise = (Int
p1, (String
n1, Float
t1)) (Int, (String, Float)) -> Times -> Times
forall a. a -> [a] -> [a]
: Times -> Times -> Times
combine Times
l Times
rs
take' :: Int -> [a] -> [a]
take' :: Int -> [a] -> [a]
take' Int
m [a]
l = let !r :: [a]
r = Int -> [a] -> [a]
forall a a. (Eq a, Num a) => a -> [a] -> [a]
tk Int
m [a]
l in [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
l Int -> [a] -> [a]
`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 (Int, [(String, Float)], [(String, Float)])
topProcesses TimesRef
tref Float
scale = do
(Times
t0, UTCTime
c0) <- TimesRef -> IO (Times, UTCTime)
forall a. IORef a -> IO a
readIORef TimesRef
tref
(Times
t1, [(String, Float)]
mis, Int
len) <- IO (Times, [(String, Float)], Int)
timeMemInfos
UTCTime
c1 <- IO UTCTime
getCurrentTime
let scx :: Float
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' :: Float
scx' = if Float
scx Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0 then Float
scx else Float
scale
nts :: [(String, Float)]
nts = ((Int, (String, Float)) -> (String, Float))
-> Times -> [(String, Float)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
_, (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' :: Times
t1' = Int -> Times -> Times
forall a. Int -> [a] -> [a]
take' (Times -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Times
t1) Times
t1
!nts' :: [(String, Float)]
nts' = Int -> [(String, Float)] -> [(String, Float)]
forall a. Int -> [a] -> [a]
take' Int
maxEntries ([(String, Float)] -> [(String, Float)]
sortTop [(String, Float)]
nts)
!mis' :: [(String, Float)]
mis' = Int -> [(String, Float)] -> [(String, Float)]
forall a. Int -> [a] -> [a]
take' Int
maxEntries ([(String, Float)] -> [(String, Float)]
sortTop [(String, Float)]
mis)
TimesRef -> (Times, UTCTime) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef TimesRef
tref (Times
t1', UTCTime
c1)
(Int, [(String, Float)], [(String, Float)])
-> IO (Int, [(String, Float)], [(String, Float)])
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
len, [(String, Float)]
nts', [(String, Float)]
mis')
showTimeInfo :: TimeInfo -> Monitor [String]
showTimeInfo :: (String, Float) -> Monitor [String]
showTimeInfo (String
n, Float
t) =
Selector Int -> Monitor Int
forall a. Selector a -> Monitor a
getConfigValue Selector Int
decDigits Monitor Int -> (Int -> Monitor [String]) -> Monitor [String]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
d -> String -> String -> Float -> Monitor [String]
showInfo String
n (Int -> Float -> String
forall a. RealFloat a => Int -> a -> String
showDigits Int
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)
mapM (String, Float) -> Monitor [String]
showTimeInfo
runTopMem :: [String] -> Monitor String
runTopMem :: [String] -> Monitor String
runTopMem [String]
_ = do
[(String, Float)]
mis <- IO [(String, Float)] -> Monitor [(String, Float)]
forall a. IO a -> Monitor a
io IO [(String, Float)]
MT.meminfos
[[String]]
pstr <- [(String, Float)] -> Monitor [[String]]
showMemInfos ([(String, Float)] -> [(String, Float)]
sortTop [(String, Float)]
mis)
[String] -> Monitor String
parseTemplate ([String] -> Monitor String) -> [String] -> Monitor String
forall a b. (a -> b) -> a -> b
$ [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String]]
pstr
runTop :: TimesRef -> Float -> [String] -> Monitor String
runTop :: TimesRef -> Float -> [String] -> Monitor String
runTop TimesRef
tref Float
scale [String]
_ = do
(Int
no, [(String, Float)]
ps, [(String, Float)]
ms) <- IO (Int, [(String, Float)], [(String, Float)])
-> Monitor (Int, [(String, Float)], [(String, Float)])
forall a. IO a -> Monitor a
io (IO (Int, [(String, Float)], [(String, Float)])
-> Monitor (Int, [(String, Float)], [(String, Float)]))
-> IO (Int, [(String, Float)], [(String, Float)])
-> Monitor (Int, [(String, Float)], [(String, Float)])
forall a b. (a -> b) -> a -> b
$ TimesRef -> Float -> IO (Int, [(String, Float)], [(String, Float)])
topProcesses TimesRef
tref Float
scale
[[String]]
pstr <- [(String, Float)] -> Monitor [[String]]
showTimeInfos [(String, Float)]
ps
[[String]]
mstr <- [(String, Float)] -> Monitor [[String]]
showMemInfos [(String, Float)]
ms
String
na <- Selector String -> Monitor String
forall a. Selector a -> Monitor a
getConfigValue Selector String
naString
[String] -> Monitor String
parseTemplate ([String] -> Monitor String) -> [String] -> Monitor String
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
no String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (([String] -> [String] -> [String])
-> [[String]] -> [[String]] -> [[String]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
(++) [[String]]
pstr [[String]]
mstr) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String -> [String]
forall a. a -> [a]
repeat String
na
startTop :: [String] -> Int -> (String -> IO ()) -> IO ()
startTop :: [String] -> Int -> (String -> IO ()) -> IO ()
startTop [String]
a Int
r String -> IO ()
cb = do
UTCTime
c <- IO UTCTime
getCurrentTime
TimesRef
tref <- (Times, UTCTime) -> IO TimesRef
forall a. a -> IO (IORef a)
newIORef ([], UTCTime
c)
Float
scale <- IO Float
MT.scale
(Int, [(String, Float)], [(String, Float)])
_ <- TimesRef -> Float -> IO (Int, [(String, Float)], [(String, Float)])
topProcesses TimesRef
tref Float
scale
[String]
-> IO MConfig
-> ([String] -> Monitor String)
-> Int
-> (String -> IO ())
-> IO ()
runM [String]
a IO MConfig
topConfig (TimesRef -> Float -> [String] -> Monitor String
runTop TimesRef
tref Float
scale) Int
r String -> IO ()
cb