{-#LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Plugins.Monitors.Top
-- Copyright   :  (c) 2010, 2011, 2012, 2013, 2014, 2018 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)
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] -> 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
"N/A"

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