-----------------------------------------------------------------------------
-- |
-- 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 <jao@gnu.org>
-- 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 :: Float
pageSize = CInt -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
c_getpagesize Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
1024

processes :: IO [FilePath]
processes :: IO [String]
processes = ([String] -> [String]) -> IO [String] -> IO [String]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
isPid) (String -> IO [String]
getDirectoryContents String
"/proc")
  where isPid :: String -> Bool
isPid = (Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'0'..Char
'9']) (Char -> Bool) -> (String -> Char) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Char
forall a. HasCallStack => [a] -> a
head

statWords :: [String] -> [String]
statWords :: [String] -> [String]
statWords line :: [String]
line@(String
x:String
pn:String
ppn:[String]
xs) =
  if String -> Char
forall a. HasCallStack => [a] -> a
last String
pn Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
')' then [String]
line else [String] -> [String]
statWords (String
xString -> [String] -> [String]
forall a. a -> [a] -> [a]
:(String
pn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ppn)String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
xs)
statWords [String]
_ = Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
52 String
"0"

getProcessData :: FilePath -> IO [String]
getProcessData :: String -> IO [String]
getProcessData String
pidf =
  (SomeException -> IO [String]) -> IO [String] -> IO [String]
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle SomeException -> IO [String]
ign (IO [String] -> IO [String]) -> IO [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ String -> IOMode -> (Handle -> IO [String]) -> IO [String]
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile (String
"/proc" String -> String -> String
</> String
pidf String -> String -> String
</> String
"stat") IOMode
ReadMode Handle -> IO [String]
readWords
  where readWords :: Handle -> IO [String]
readWords = (String -> [String]) -> IO String -> IO [String]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([String] -> [String]
statWords ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words) (IO String -> IO [String])
-> (Handle -> IO String) -> Handle -> IO [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO String
hGetLine
        ign :: SomeException -> IO [String]
ign = IO [String] -> SomeException -> IO [String]
forall a b. a -> b -> a
const ([String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []) :: SomeException -> IO [String]

memPages :: [String] -> String
memPages :: [String] -> String
memPages [String]
fs = [String]
fs[String] -> Int -> String
forall a. HasCallStack => [a] -> Int -> a
!!Int
23

ppid :: [String] -> String
ppid :: [String] -> String
ppid [String]
fs = [String]
fs[String] -> Int -> String
forall a. HasCallStack => [a] -> Int -> a
!!Int
3

skip :: [String] -> Bool
skip :: [String] -> Bool
skip [String]
fs = [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
fs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
24 Bool -> Bool -> Bool
|| [String] -> String
memPages [String]
fs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"0" Bool -> Bool -> Bool
|| [String] -> String
ppid [String]
fs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"0"

handleProcesses :: ([String] -> a) -> IO [a]
handleProcesses :: forall a. ([String] -> a) -> IO [a]
handleProcesses [String] -> a
f =
  ([[String]] -> [a]) -> IO [[String]] -> IO [a]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([a] -> [String] -> [a]) -> [a] -> [[String]] -> [a]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\[a]
a [String]
p -> if [String] -> Bool
skip [String]
p then [a]
a else [String] -> a
f [String]
p a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
a) [])
       (IO [String]
processes IO [String] -> ([String] -> IO [[String]]) -> IO [[String]]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> IO [String]) -> [String] -> IO [[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 -> IO [String]
getProcessData)

processName :: [String] -> String
processName :: [String] -> String
processName = Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 (String -> String) -> ([String] -> String) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. HasCallStack => [a] -> [a]
init (String -> String) -> ([String] -> String) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> Int -> String
forall a. HasCallStack => [a] -> Int -> a
!!Int
1)

meminfo :: [String] -> MemInfo
meminfo :: [String] -> MemInfo
meminfo [String]
fs = ([String] -> String
processName [String]
fs, Float
pageSize Float -> Float -> Float
forall a. Num a => a -> a -> a
* String -> Float
parseFloat ([String]
fs[String] -> Int -> String
forall a. HasCallStack => [a] -> Int -> a
!!Int
23))

meminfos :: IO [MemInfo]
meminfos :: IO [MemInfo]
meminfos = ([String] -> MemInfo) -> IO [MemInfo]
forall a. ([String] -> a) -> IO [a]
handleProcesses [String] -> MemInfo
meminfo

timeMemEntry :: [String] -> (TimeEntry, MemInfo)
timeMemEntry :: [String] -> (TimeEntry, MemInfo)
timeMemEntry [String]
fs = ((Int
p, (String
n, Float
t)), (String
n, Float
r))
  where p :: Int
p = String -> Int
parseInt ([String] -> String
forall a. HasCallStack => [a] -> a
head [String]
fs)
        n :: String
n = [String] -> String
processName [String]
fs
        t :: Float
t = String -> Float
parseFloat ([String]
fs[String] -> Int -> String
forall a. HasCallStack => [a] -> Int -> a
!!Int
13) Float -> Float -> Float
forall a. Num a => a -> a -> a
+ String -> Float
parseFloat ([String]
fs[String] -> Int -> String
forall a. HasCallStack => [a] -> Int -> a
!!Int
14)
        (String
_, Float
r) = [String] -> MemInfo
meminfo [String]
fs

timeMemEntries :: IO [(TimeEntry, MemInfo)]
timeMemEntries :: IO [(TimeEntry, MemInfo)]
timeMemEntries = ([String] -> (TimeEntry, MemInfo)) -> IO [(TimeEntry, MemInfo)]
forall a. ([String] -> a) -> IO [a]
handleProcesses [String] -> (TimeEntry, MemInfo)
timeMemEntry


scale :: IO Float
scale :: IO Float
scale = do
  cr <- SysVar -> IO Integer
getSysVar SysVar
ClockTick
  return $ fromIntegral cr / 100