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

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

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

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

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

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

handleProcesses :: ([String] -> a) -> IO [a]
handleProcesses :: ([FilePath] -> a) -> IO [a]
handleProcesses [FilePath] -> a
f =
  ([[FilePath]] -> [a]) -> IO [[FilePath]] -> IO [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([a] -> [FilePath] -> [a]) -> [a] -> [[FilePath]] -> [a]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\[a]
a [FilePath]
p -> if [FilePath] -> Bool
skip [FilePath]
p then [a]
a else [FilePath] -> a
f [FilePath]
p a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
a) [])
       (IO [FilePath]
processes IO [FilePath] -> ([FilePath] -> IO [[FilePath]]) -> IO [[FilePath]]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> IO [FilePath]) -> [FilePath] -> IO [[FilePath]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> IO [FilePath]
getProcessData)

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

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

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

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

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


scale :: IO Float
scale :: IO Float
scale = do
  Integer
cr <- SysVar -> IO Integer
getSysVar SysVar
ClockTick
  Float -> IO Float
forall (m :: * -> *) a. Monad m => a -> m a
return (Float -> IO Float) -> Float -> IO Float
forall a b. (a -> b) -> a -> b
$ Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
cr Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
100