{-#LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Plugins.Monitors.Top
-- Copyright   :  (c) 2010-2014, 2018, 2022, 2025 Jose A Ortega Ruiz
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Jose A Ortega Ruiz <jao@gnu.org>
-- Stability   :  unstable
-- Portability :  unportable
--
--  Process activity and memory consumption monitors
--
-----------------------------------------------------------------------------

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