{-#LANGUAGE CPP #-}
{-#LANGUAGE RecordWildCards#-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Plugins.Monitors.Cpu
-- Copyright   :  (c) 2011, 2017 Jose Antonio Ortega Ruiz
--                (c) 2007-2010 Andrea Rossato
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Jose A. Ortega Ruiz <jao@gnu.org>
-- Stability   :  unstable
-- Portability :  unportable
--
-- A cpu monitor for Xmobar
--
-----------------------------------------------------------------------------

module Xmobar.Plugins.Monitors.Cpu
  ( startCpu
  , runCpu
  , cpuConfig
  , CpuDataRef
  , CpuOpts
  , CpuArguments
  , parseCpu
  , getArguments
  ) where

import Xmobar.Plugins.Monitors.Common
import qualified Data.ByteString.Lazy.Char8 as B
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
#ifdef FREEBSD
import System.BSD.Sysctl (sysctlPeekArray)
#endif
import System.Console.GetOpt
import Xmobar.App.Timer (doEveryTenthSeconds)
import Control.Monad (void)

newtype CpuOpts = CpuOpts
  { CpuOpts -> Maybe IconPattern
loadIconPattern :: Maybe IconPattern
  }

defaultOpts :: CpuOpts
defaultOpts :: CpuOpts
defaultOpts = CpuOpts :: Maybe IconPattern -> CpuOpts
CpuOpts
  { loadIconPattern :: Maybe IconPattern
loadIconPattern = Maybe IconPattern
forall a. Maybe a
Nothing
  }

options :: [OptDescr (CpuOpts -> CpuOpts)]
options :: [OptDescr (CpuOpts -> CpuOpts)]
options =
  [ [Char]
-> [[Char]]
-> ArgDescr (CpuOpts -> CpuOpts)
-> [Char]
-> OptDescr (CpuOpts -> CpuOpts)
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char]
"" [[Char]
"load-icon-pattern"] (([Char] -> CpuOpts -> CpuOpts)
-> [Char] -> ArgDescr (CpuOpts -> CpuOpts)
forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg (\[Char]
x CpuOpts
o ->
     CpuOpts
o { loadIconPattern :: Maybe IconPattern
loadIconPattern = IconPattern -> Maybe IconPattern
forall a. a -> Maybe a
Just (IconPattern -> Maybe IconPattern)
-> IconPattern -> Maybe IconPattern
forall a b. (a -> b) -> a -> b
$ [Char] -> IconPattern
parseIconPattern [Char]
x }) [Char]
"") [Char]
""
  ]

barField :: String
barField :: [Char]
barField = [Char]
"bar"

vbarField :: String
vbarField :: [Char]
vbarField = [Char]
"vbar"

ipatField :: String
ipatField :: [Char]
ipatField = [Char]
"ipat"

totalField :: String
totalField :: [Char]
totalField = [Char]
"total"

userField :: String
userField :: [Char]
userField = [Char]
"user"

niceField :: String
niceField :: [Char]
niceField = [Char]
"nice"

systemField :: String
systemField :: [Char]
systemField = [Char]
"system"

idleField :: String
idleField :: [Char]
idleField = [Char]
"idle"

iowaitField :: String
iowaitField :: [Char]
iowaitField = [Char]
"iowait"

cpuConfig :: IO MConfig
cpuConfig :: IO MConfig
cpuConfig =
  [Char] -> [[Char]] -> IO MConfig
mkMConfig
    [Char]
"Cpu: <total>%"
    [ [Char]
barField
    , [Char]
vbarField
    , [Char]
ipatField
    , [Char]
totalField
    , [Char]
userField
    , [Char]
niceField
    , [Char]
systemField
    , [Char]
idleField
    , [Char]
iowaitField
    ]

data CpuData = CpuData {
      CpuData -> Float
cpuUser :: !Float,
      CpuData -> Float
cpuNice :: !Float,
      CpuData -> Float
cpuSystem :: !Float,
      CpuData -> Float
cpuIdle :: !Float,
      CpuData -> Float
cpuIowait :: !Float,
      CpuData -> Float
cpuTotal :: !Float
    }

#ifdef FREEBSD
-- kern.cp_time data from the previous iteration for computing the difference
type CpuDataRef = IORef [Word]

cpuData :: IO [Word]
cpuData = sysctlPeekArray "kern.cp_time" :: IO [Word]

parseCpu :: CpuDataRef -> IO CpuData
parseCpu cref = do
    prev <- readIORef cref
    curr <- cpuData
    writeIORef cref curr
    let diff = map fromIntegral $ zipWith (-) curr prev
        user = diff !! 0
        nice = diff !! 1
        system = diff !! 2
        intr = diff !! 3
        idle = diff !! 4
        total = user + nice + system + intr + idle
    return CpuData
      { cpuUser = user/total
      , cpuNice = nice/total
      , cpuSystem = (system+intr)/total
      , cpuIdle = idle/total
      , cpuIowait = 0
      , cpuTotal = user/total
      }
#else
type CpuDataRef = IORef [Int]

-- Details about the fields here: https://www.kernel.org/doc/Documentation/filesystems/proc.txt
cpuData :: IO [Int]
cpuData :: IO [Int]
cpuData = ByteString -> [Int]
cpuParser (ByteString -> [Int]) -> IO ByteString -> IO [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO ByteString
B.readFile [Char]
"/proc/stat"

readInt :: B.ByteString -> Int
readInt :: ByteString -> Int
readInt ByteString
bs = case ByteString -> Maybe (Int, ByteString)
B.readInt ByteString
bs of
               Maybe (Int, ByteString)
Nothing -> Int
0
               Just (Int
i, ByteString
_) -> Int
i

cpuParser :: B.ByteString -> [Int]
cpuParser :: ByteString -> [Int]
cpuParser = (ByteString -> Int) -> [ByteString] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Int
readInt ([ByteString] -> [Int])
-> (ByteString -> [ByteString]) -> ByteString -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [ByteString]
forall a. [a] -> [a]
tail ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
B.words (ByteString -> [ByteString])
-> (ByteString -> ByteString) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
forall a. [a] -> a
head ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
B.lines

convertToCpuData :: [Float] -> CpuData
convertToCpuData :: [Float] -> CpuData
convertToCpuData (Float
u:Float
n:Float
s:Float
ie:Float
iw:[Float]
_) =
  CpuData :: Float -> Float -> Float -> Float -> Float -> Float -> CpuData
CpuData
    { cpuUser :: Float
cpuUser = Float
u
    , cpuNice :: Float
cpuNice = Float
n
    , cpuSystem :: Float
cpuSystem = Float
s
    , cpuIdle :: Float
cpuIdle = Float
ie
    , cpuIowait :: Float
cpuIowait = Float
iw
    , cpuTotal :: Float
cpuTotal = [Float] -> Float
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Float
u, Float
n, Float
s]
    }
convertToCpuData [Float]
args = [Char] -> CpuData
forall a. HasCallStack => [Char] -> a
error ([Char] -> CpuData) -> [Char] -> CpuData
forall a b. (a -> b) -> a -> b
$ [Char]
"convertToCpuData: Unexpected list" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Float] -> [Char]
forall a. Show a => a -> [Char]
show [Float]
args

parseCpu :: CpuDataRef -> IO CpuData
parseCpu :: CpuDataRef -> IO CpuData
parseCpu CpuDataRef
cref =
    do [Int]
a <- CpuDataRef -> IO [Int]
forall a. IORef a -> IO a
readIORef CpuDataRef
cref
       [Int]
b <- IO [Int]
cpuData
       CpuDataRef -> [Int] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef CpuDataRef
cref [Int]
b
       let dif :: [Int]
dif = (Int -> Int -> Int) -> [Int] -> [Int] -> [Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) [Int]
b [Int]
a
           tot :: Float
tot = Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Float) -> Int -> Float
forall a b. (a -> b) -> a -> b
$ [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
dif
           safeDiv :: a -> Float
safeDiv a
n = case Float
tot of
                         Float
0 -> Float
0
                         Float
v -> a -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
v
           percent :: [Float]
percent = (Int -> Float) -> [Int] -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Float
forall a. Integral a => a -> Float
safeDiv [Int]
dif
       CpuData -> IO CpuData
forall (m :: * -> *) a. Monad m => a -> m a
return (CpuData -> IO CpuData) -> CpuData -> IO CpuData
forall a b. (a -> b) -> a -> b
$ [Float] -> CpuData
convertToCpuData [Float]
percent
#endif

data Field = Field {
      Field -> [Char]
fieldName :: !String,
      Field -> ShouldCompute
fieldCompute :: !ShouldCompute
    } deriving (Field -> Field -> Bool
(Field -> Field -> Bool) -> (Field -> Field -> Bool) -> Eq Field
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Field -> Field -> Bool
$c/= :: Field -> Field -> Bool
== :: Field -> Field -> Bool
$c== :: Field -> Field -> Bool
Eq, Eq Field
Eq Field
-> (Field -> Field -> Ordering)
-> (Field -> Field -> Bool)
-> (Field -> Field -> Bool)
-> (Field -> Field -> Bool)
-> (Field -> Field -> Bool)
-> (Field -> Field -> Field)
-> (Field -> Field -> Field)
-> Ord Field
Field -> Field -> Bool
Field -> Field -> Ordering
Field -> Field -> Field
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Field -> Field -> Field
$cmin :: Field -> Field -> Field
max :: Field -> Field -> Field
$cmax :: Field -> Field -> Field
>= :: Field -> Field -> Bool
$c>= :: Field -> Field -> Bool
> :: Field -> Field -> Bool
$c> :: Field -> Field -> Bool
<= :: Field -> Field -> Bool
$c<= :: Field -> Field -> Bool
< :: Field -> Field -> Bool
$c< :: Field -> Field -> Bool
compare :: Field -> Field -> Ordering
$ccompare :: Field -> Field -> Ordering
$cp1Ord :: Eq Field
Ord, Int -> Field -> [Char] -> [Char]
[Field] -> [Char] -> [Char]
Field -> [Char]
(Int -> Field -> [Char] -> [Char])
-> (Field -> [Char]) -> ([Field] -> [Char] -> [Char]) -> Show Field
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [Field] -> [Char] -> [Char]
$cshowList :: [Field] -> [Char] -> [Char]
show :: Field -> [Char]
$cshow :: Field -> [Char]
showsPrec :: Int -> Field -> [Char] -> [Char]
$cshowsPrec :: Int -> Field -> [Char] -> [Char]
Show)

data ShouldCompute = Compute | Skip deriving (ShouldCompute -> ShouldCompute -> Bool
(ShouldCompute -> ShouldCompute -> Bool)
-> (ShouldCompute -> ShouldCompute -> Bool) -> Eq ShouldCompute
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShouldCompute -> ShouldCompute -> Bool
$c/= :: ShouldCompute -> ShouldCompute -> Bool
== :: ShouldCompute -> ShouldCompute -> Bool
$c== :: ShouldCompute -> ShouldCompute -> Bool
Eq, Eq ShouldCompute
Eq ShouldCompute
-> (ShouldCompute -> ShouldCompute -> Ordering)
-> (ShouldCompute -> ShouldCompute -> Bool)
-> (ShouldCompute -> ShouldCompute -> Bool)
-> (ShouldCompute -> ShouldCompute -> Bool)
-> (ShouldCompute -> ShouldCompute -> Bool)
-> (ShouldCompute -> ShouldCompute -> ShouldCompute)
-> (ShouldCompute -> ShouldCompute -> ShouldCompute)
-> Ord ShouldCompute
ShouldCompute -> ShouldCompute -> Bool
ShouldCompute -> ShouldCompute -> Ordering
ShouldCompute -> ShouldCompute -> ShouldCompute
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ShouldCompute -> ShouldCompute -> ShouldCompute
$cmin :: ShouldCompute -> ShouldCompute -> ShouldCompute
max :: ShouldCompute -> ShouldCompute -> ShouldCompute
$cmax :: ShouldCompute -> ShouldCompute -> ShouldCompute
>= :: ShouldCompute -> ShouldCompute -> Bool
$c>= :: ShouldCompute -> ShouldCompute -> Bool
> :: ShouldCompute -> ShouldCompute -> Bool
$c> :: ShouldCompute -> ShouldCompute -> Bool
<= :: ShouldCompute -> ShouldCompute -> Bool
$c<= :: ShouldCompute -> ShouldCompute -> Bool
< :: ShouldCompute -> ShouldCompute -> Bool
$c< :: ShouldCompute -> ShouldCompute -> Bool
compare :: ShouldCompute -> ShouldCompute -> Ordering
$ccompare :: ShouldCompute -> ShouldCompute -> Ordering
$cp1Ord :: Eq ShouldCompute
Ord, Int -> ShouldCompute -> [Char] -> [Char]
[ShouldCompute] -> [Char] -> [Char]
ShouldCompute -> [Char]
(Int -> ShouldCompute -> [Char] -> [Char])
-> (ShouldCompute -> [Char])
-> ([ShouldCompute] -> [Char] -> [Char])
-> Show ShouldCompute
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [ShouldCompute] -> [Char] -> [Char]
$cshowList :: [ShouldCompute] -> [Char] -> [Char]
show :: ShouldCompute -> [Char]
$cshow :: ShouldCompute -> [Char]
showsPrec :: Int -> ShouldCompute -> [Char] -> [Char]
$cshowsPrec :: Int -> ShouldCompute -> [Char] -> [Char]
Show)

formatField :: MonitorConfig -> CpuOpts -> CpuData -> Field -> IO String
formatField :: MonitorConfig -> CpuOpts -> CpuData -> Field -> IO [Char]
formatField MonitorConfig
cpuParams CpuOpts
cpuOpts cpuInfo :: CpuData
cpuInfo@CpuData {Float
cpuTotal :: Float
cpuIowait :: Float
cpuIdle :: Float
cpuSystem :: Float
cpuNice :: Float
cpuUser :: Float
cpuTotal :: CpuData -> Float
cpuIowait :: CpuData -> Float
cpuIdle :: CpuData -> Float
cpuSystem :: CpuData -> Float
cpuNice :: CpuData -> Float
cpuUser :: CpuData -> Float
..} Field {[Char]
ShouldCompute
fieldCompute :: ShouldCompute
fieldName :: [Char]
fieldCompute :: Field -> ShouldCompute
fieldName :: Field -> [Char]
..}
  | [Char]
fieldName [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
barField =
    if ShouldCompute
fieldCompute ShouldCompute -> ShouldCompute -> Bool
forall a. Eq a => a -> a -> Bool
== ShouldCompute
Compute
      then MonitorConfig -> Float -> Float -> IO [Char]
forall (m :: * -> *).
MonadIO m =>
MonitorConfig -> Float -> Float -> m [Char]
pShowPercentBar MonitorConfig
cpuParams (Float
100 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
cpuTotal) Float
cpuTotal
      else [Char] -> IO [Char]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  | [Char]
fieldName [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
vbarField =
    if ShouldCompute
fieldCompute ShouldCompute -> ShouldCompute -> Bool
forall a. Eq a => a -> a -> Bool
== ShouldCompute
Compute
      then MonitorConfig -> Float -> Float -> IO [Char]
forall (m :: * -> *).
MonadIO m =>
MonitorConfig -> Float -> Float -> m [Char]
pShowVerticalBar MonitorConfig
cpuParams (Float
100 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
cpuTotal) Float
cpuTotal
      else [Char] -> IO [Char]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  | [Char]
fieldName [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
ipatField =
    if ShouldCompute
fieldCompute ShouldCompute -> ShouldCompute -> Bool
forall a. Eq a => a -> a -> Bool
== ShouldCompute
Compute
      then Maybe IconPattern -> Float -> IO [Char]
pShowIconPattern (CpuOpts -> Maybe IconPattern
loadIconPattern CpuOpts
cpuOpts) Float
cpuTotal
      else [Char] -> IO [Char]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  | Bool
otherwise =
    if ShouldCompute
fieldCompute ShouldCompute -> ShouldCompute -> Bool
forall a. Eq a => a -> a -> Bool
== ShouldCompute
Compute
      then MonitorConfig -> Float -> IO [Char]
forall (m :: * -> *).
MonadIO m =>
MonitorConfig -> Float -> m [Char]
pShowPercentWithColors MonitorConfig
cpuParams ([Char] -> CpuData -> Float
getFieldValue [Char]
fieldName CpuData
cpuInfo)
      else [Char] -> IO [Char]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

getFieldValue :: String -> CpuData -> Float
getFieldValue :: [Char] -> CpuData -> Float
getFieldValue [Char]
field CpuData{Float
cpuTotal :: Float
cpuIowait :: Float
cpuIdle :: Float
cpuSystem :: Float
cpuNice :: Float
cpuUser :: Float
cpuTotal :: CpuData -> Float
cpuIowait :: CpuData -> Float
cpuIdle :: CpuData -> Float
cpuSystem :: CpuData -> Float
cpuNice :: CpuData -> Float
cpuUser :: CpuData -> Float
..}
    | [Char]
field [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
barField = Float
cpuTotal
    | [Char]
field [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
vbarField = Float
cpuTotal
    | [Char]
field [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
ipatField = Float
cpuTotal
    | [Char]
field [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
totalField = Float
cpuTotal
    | [Char]
field [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
userField = Float
cpuUser
    | [Char]
field [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
niceField = Float
cpuNice
    | [Char]
field [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
systemField = Float
cpuSystem
    | [Char]
field [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
idleField = Float
cpuIdle
    | Bool
otherwise = Float
cpuIowait

computeFields :: [String] -> [String] -> [Field]
computeFields :: [[Char]] -> [[Char]] -> [Field]
computeFields [] [[Char]]
_ = []
computeFields ([Char]
x:[[Char]]
xs) [[Char]]
inputFields =
  if [Char]
x [Char] -> [[Char]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
inputFields
    then (Field :: [Char] -> ShouldCompute -> Field
Field {fieldName :: [Char]
fieldName = [Char]
x, fieldCompute :: ShouldCompute
fieldCompute = ShouldCompute
Compute}) Field -> [Field] -> [Field]
forall a. a -> [a] -> [a]
:
         [[Char]] -> [[Char]] -> [Field]
computeFields [[Char]]
xs [[Char]]
inputFields
    else (Field :: [Char] -> ShouldCompute -> Field
Field {fieldName :: [Char]
fieldName = [Char]
x, fieldCompute :: ShouldCompute
fieldCompute = ShouldCompute
Skip}) Field -> [Field] -> [Field]
forall a. a -> [a] -> [a]
:
         [[Char]] -> [[Char]] -> [Field]
computeFields [[Char]]
xs [[Char]]
inputFields

formatCpu :: CpuArguments -> CpuData -> IO [String]
formatCpu :: CpuArguments -> CpuData -> IO [[Char]]
formatCpu CpuArguments{[[Char]]
[([Char], [([Char], [Char], [Char])])]
[([Char], [Char], [Char])]
[Field]
CpuDataRef
MonitorConfig
CpuOpts
cpuFields :: CpuArguments -> [Field]
cpuAllTemplate :: CpuArguments -> [([Char], [([Char], [Char], [Char])])]
cpuInputTemplate :: CpuArguments -> [([Char], [Char], [Char])]
cpuOpts :: CpuArguments -> CpuOpts
cpuArgs :: CpuArguments -> [[Char]]
cpuParams :: CpuArguments -> MonitorConfig
cpuDataRef :: CpuArguments -> CpuDataRef
cpuFields :: [Field]
cpuAllTemplate :: [([Char], [([Char], [Char], [Char])])]
cpuInputTemplate :: [([Char], [Char], [Char])]
cpuOpts :: CpuOpts
cpuArgs :: [[Char]]
cpuParams :: MonitorConfig
cpuDataRef :: CpuDataRef
..} CpuData
cpuInfo = do
  [[Char]]
strs <- (Field -> IO [Char]) -> [Field] -> IO [[Char]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (MonitorConfig -> CpuOpts -> CpuData -> Field -> IO [Char]
formatField MonitorConfig
cpuParams CpuOpts
cpuOpts CpuData
cpuInfo) [Field]
cpuFields
  [[Char]] -> IO [[Char]]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([[Char]] -> IO [[Char]]) -> [[Char]] -> IO [[Char]]
forall a b. (a -> b) -> a -> b
$ ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([Char] -> Bool) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [[Char]]
strs

getInputFields :: CpuArguments -> [String]
getInputFields :: CpuArguments -> [[Char]]
getInputFields CpuArguments{[[Char]]
[([Char], [([Char], [Char], [Char])])]
[([Char], [Char], [Char])]
[Field]
CpuDataRef
MonitorConfig
CpuOpts
cpuFields :: [Field]
cpuAllTemplate :: [([Char], [([Char], [Char], [Char])])]
cpuInputTemplate :: [([Char], [Char], [Char])]
cpuOpts :: CpuOpts
cpuArgs :: [[Char]]
cpuParams :: MonitorConfig
cpuDataRef :: CpuDataRef
cpuFields :: CpuArguments -> [Field]
cpuAllTemplate :: CpuArguments -> [([Char], [([Char], [Char], [Char])])]
cpuInputTemplate :: CpuArguments -> [([Char], [Char], [Char])]
cpuOpts :: CpuArguments -> CpuOpts
cpuArgs :: CpuArguments -> [[Char]]
cpuParams :: CpuArguments -> MonitorConfig
cpuDataRef :: CpuArguments -> CpuDataRef
..} = (([Char], [Char], [Char]) -> [Char])
-> [([Char], [Char], [Char])] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\([Char]
_,[Char]
f,[Char]
_) -> [Char]
f) [([Char], [Char], [Char])]
cpuInputTemplate

optimizeAllTemplate :: CpuArguments -> CpuArguments
optimizeAllTemplate :: CpuArguments -> CpuArguments
optimizeAllTemplate args :: CpuArguments
args@CpuArguments {[[Char]]
[([Char], [([Char], [Char], [Char])])]
[([Char], [Char], [Char])]
[Field]
CpuDataRef
MonitorConfig
CpuOpts
cpuFields :: [Field]
cpuAllTemplate :: [([Char], [([Char], [Char], [Char])])]
cpuInputTemplate :: [([Char], [Char], [Char])]
cpuOpts :: CpuOpts
cpuArgs :: [[Char]]
cpuParams :: MonitorConfig
cpuDataRef :: CpuDataRef
cpuFields :: CpuArguments -> [Field]
cpuAllTemplate :: CpuArguments -> [([Char], [([Char], [Char], [Char])])]
cpuInputTemplate :: CpuArguments -> [([Char], [Char], [Char])]
cpuOpts :: CpuArguments -> CpuOpts
cpuArgs :: CpuArguments -> [[Char]]
cpuParams :: CpuArguments -> MonitorConfig
cpuDataRef :: CpuArguments -> CpuDataRef
..} =
  let inputFields :: [[Char]]
inputFields = CpuArguments -> [[Char]]
getInputFields CpuArguments
args
      allTemplates :: [([Char], [([Char], [Char], [Char])])]
allTemplates =
        (([Char], [([Char], [Char], [Char])]) -> Bool)
-> [([Char], [([Char], [Char], [Char])])]
-> [([Char], [([Char], [Char], [Char])])]
forall a. (a -> Bool) -> [a] -> [a]
filter (\([Char]
field, [([Char], [Char], [Char])]
_) -> [Char]
field [Char] -> [[Char]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
inputFields) [([Char], [([Char], [Char], [Char])])]
cpuAllTemplate
   in CpuArguments
args {cpuAllTemplate :: [([Char], [([Char], [Char], [Char])])]
cpuAllTemplate = [([Char], [([Char], [Char], [Char])])]
allTemplates}

data CpuArguments =
  CpuArguments
    { CpuArguments -> CpuDataRef
cpuDataRef :: !CpuDataRef
    , CpuArguments -> MonitorConfig
cpuParams :: !MonitorConfig
    , CpuArguments -> [[Char]]
cpuArgs :: ![String]
    , CpuArguments -> CpuOpts
cpuOpts :: !CpuOpts
    , CpuArguments -> [([Char], [Char], [Char])]
cpuInputTemplate :: ![(String, String, String)] -- [("Cpu: ","total","% "),("","user","%")]
    , CpuArguments -> [([Char], [([Char], [Char], [Char])])]
cpuAllTemplate :: ![(String, [(String, String, String)])] -- [("bar",[]),("vbar",[]),("ipat",[]),("total",[]),...]
    , CpuArguments -> [Field]
cpuFields :: ![Field]
    }


getArguments :: [String] -> IO CpuArguments
getArguments :: [[Char]] -> IO CpuArguments
getArguments [[Char]]
cpuArgs = do
  [Int]
initCpuData <- IO [Int]
cpuData
  CpuDataRef
cpuDataRef <- [Int] -> IO CpuDataRef
forall a. a -> IO (IORef a)
newIORef [Int]
initCpuData
  IO CpuData -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO CpuData -> IO ()) -> IO CpuData -> IO ()
forall a b. (a -> b) -> a -> b
$ CpuDataRef -> IO CpuData
parseCpu CpuDataRef
cpuDataRef
  MonitorConfig
cpuParams <- [[Char]] -> IO MConfig -> IO MonitorConfig
computeMonitorConfig [[Char]]
cpuArgs IO MConfig
cpuConfig
  [([Char], [Char], [Char])]
cpuInputTemplate <- MonitorConfig -> IO [([Char], [Char], [Char])]
runTemplateParser MonitorConfig
cpuParams
  [([Char], [([Char], [Char], [Char])])]
cpuAllTemplate <- [[Char]] -> IO [([Char], [([Char], [Char], [Char])])]
runExportParser (MonitorConfig -> [[Char]]
pExport MonitorConfig
cpuParams)
  [[Char]]
nonOptions <-
    case ArgOrder Opts
-> [OptDescr Opts] -> [[Char]] -> ([Opts], [[Char]], [[Char]])
forall a.
ArgOrder a -> [OptDescr a] -> [[Char]] -> ([a], [[Char]], [[Char]])
getOpt ArgOrder Opts
forall a. ArgOrder a
Permute [OptDescr Opts]
pluginOptions [[Char]]
cpuArgs of
      ([Opts]
_, [[Char]]
n, []) -> [[Char]] -> IO [[Char]]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [[Char]]
n
      ([Opts]
_, [[Char]]
_, [[Char]]
errs) -> [Char] -> IO [[Char]]
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO [[Char]]) -> [Char] -> IO [[Char]]
forall a b. (a -> b) -> a -> b
$ [Char]
"getArguments: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [[Char]] -> [Char]
forall a. Show a => a -> [Char]
show [[Char]]
errs
  CpuOpts
cpuOpts <-
    case ArgOrder (CpuOpts -> CpuOpts)
-> [OptDescr (CpuOpts -> CpuOpts)]
-> [[Char]]
-> ([CpuOpts -> CpuOpts], [[Char]], [[Char]])
forall a.
ArgOrder a -> [OptDescr a] -> [[Char]] -> ([a], [[Char]], [[Char]])
getOpt ArgOrder (CpuOpts -> CpuOpts)
forall a. ArgOrder a
Permute [OptDescr (CpuOpts -> CpuOpts)]
options [[Char]]
nonOptions of
      ([CpuOpts -> CpuOpts]
o, [[Char]]
_, []) -> CpuOpts -> IO CpuOpts
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CpuOpts -> IO CpuOpts) -> CpuOpts -> IO CpuOpts
forall a b. (a -> b) -> a -> b
$ ((CpuOpts -> CpuOpts) -> CpuOpts -> CpuOpts)
-> CpuOpts -> [CpuOpts -> CpuOpts] -> CpuOpts
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (CpuOpts -> CpuOpts) -> CpuOpts -> CpuOpts
forall a. a -> a
id CpuOpts
defaultOpts [CpuOpts -> CpuOpts]
o
      ([CpuOpts -> CpuOpts]
_, [[Char]]
_, [[Char]]
errs) -> [Char] -> IO CpuOpts
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO CpuOpts) -> [Char] -> IO CpuOpts
forall a b. (a -> b) -> a -> b
$ [Char]
"getArguments options: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [[Char]] -> [Char]
forall a. Show a => a -> [Char]
show [[Char]]
errs
  let cpuFields :: [Field]
cpuFields =
        [[Char]] -> [[Char]] -> [Field]
computeFields
          ((([Char], [([Char], [Char], [Char])]) -> [Char])
-> [([Char], [([Char], [Char], [Char])])] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], [([Char], [Char], [Char])]) -> [Char]
forall a b. (a, b) -> a
fst [([Char], [([Char], [Char], [Char])])]
cpuAllTemplate)
          ((([Char], [Char], [Char]) -> [Char])
-> [([Char], [Char], [Char])] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\([Char]
_, [Char]
f, [Char]
_) -> [Char]
f) [([Char], [Char], [Char])]
cpuInputTemplate)
  CpuArguments -> IO CpuArguments
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CpuArguments -> IO CpuArguments)
-> CpuArguments -> IO CpuArguments
forall a b. (a -> b) -> a -> b
$ CpuArguments -> CpuArguments
optimizeAllTemplate CpuArguments :: CpuDataRef
-> MonitorConfig
-> [[Char]]
-> CpuOpts
-> [([Char], [Char], [Char])]
-> [([Char], [([Char], [Char], [Char])])]
-> [Field]
-> CpuArguments
CpuArguments {[[Char]]
[([Char], [([Char], [Char], [Char])])]
[([Char], [Char], [Char])]
[Field]
CpuDataRef
MonitorConfig
CpuOpts
cpuFields :: [Field]
cpuOpts :: CpuOpts
cpuAllTemplate :: [([Char], [([Char], [Char], [Char])])]
cpuInputTemplate :: [([Char], [Char], [Char])]
cpuParams :: MonitorConfig
cpuDataRef :: CpuDataRef
cpuArgs :: [[Char]]
cpuFields :: [Field]
cpuAllTemplate :: [([Char], [([Char], [Char], [Char])])]
cpuInputTemplate :: [([Char], [Char], [Char])]
cpuOpts :: CpuOpts
cpuArgs :: [[Char]]
cpuParams :: MonitorConfig
cpuDataRef :: CpuDataRef
..}


runCpu :: CpuArguments -> IO String
runCpu :: CpuArguments -> IO [Char]
runCpu args :: CpuArguments
args@CpuArguments {[[Char]]
[([Char], [([Char], [Char], [Char])])]
[([Char], [Char], [Char])]
[Field]
CpuDataRef
MonitorConfig
CpuOpts
cpuFields :: [Field]
cpuAllTemplate :: [([Char], [([Char], [Char], [Char])])]
cpuInputTemplate :: [([Char], [Char], [Char])]
cpuOpts :: CpuOpts
cpuArgs :: [[Char]]
cpuParams :: MonitorConfig
cpuDataRef :: CpuDataRef
cpuFields :: CpuArguments -> [Field]
cpuAllTemplate :: CpuArguments -> [([Char], [([Char], [Char], [Char])])]
cpuInputTemplate :: CpuArguments -> [([Char], [Char], [Char])]
cpuOpts :: CpuArguments -> CpuOpts
cpuArgs :: CpuArguments -> [[Char]]
cpuParams :: CpuArguments -> MonitorConfig
cpuDataRef :: CpuArguments -> CpuDataRef
..} = do
  CpuData
cpuValue <- CpuDataRef -> IO CpuData
parseCpu CpuDataRef
cpuDataRef
  [[Char]]
temMonitorValues <- CpuArguments -> CpuData -> IO [[Char]]
formatCpu CpuArguments
args CpuData
cpuValue
  let templateInput :: TemplateInput
templateInput =
        TemplateInput :: [[Char]]
-> [([Char], [Char], [Char])]
-> [([Char], [([Char], [Char], [Char])])]
-> TemplateInput
TemplateInput
          { temInputTemplate :: [([Char], [Char], [Char])]
temInputTemplate = [([Char], [Char], [Char])]
cpuInputTemplate
          , temAllTemplate :: [([Char], [([Char], [Char], [Char])])]
temAllTemplate = [([Char], [([Char], [Char], [Char])])]
cpuAllTemplate
          , [[Char]]
temMonitorValues :: [[Char]]
temMonitorValues :: [[Char]]
..
          }
  MonitorConfig -> TemplateInput -> IO [Char]
pureParseTemplate MonitorConfig
cpuParams TemplateInput
templateInput

startCpu :: [String] -> Int -> (String -> IO ()) -> IO ()
startCpu :: [[Char]] -> Int -> ([Char] -> IO ()) -> IO ()
startCpu [[Char]]
args Int
refreshRate [Char] -> IO ()
cb = do
  CpuArguments
cpuArgs <- [[Char]] -> IO CpuArguments
getArguments [[Char]]
args
  Int -> IO () -> IO ()
doEveryTenthSeconds Int
refreshRate (CpuArguments -> IO [Char]
runCpu CpuArguments
cpuArgs IO [Char] -> ([Char] -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> IO ()
cb)