{-#LANGUAGE CPP #-}
{-#LANGUAGE RecordWildCards#-}
module Xmobar.Plugins.Monitors.Cpu
( startCpu
, runCpu
, cpuConfig
, MC.CpuDataRef
, CpuOpts
, CpuArguments
, MC.parseCpu
, getArguments
) where
import Xmobar.Plugins.Monitors.Common
import Data.IORef (newIORef)
import System.Console.GetOpt
import Xmobar.Run.Timer (doEveryTenthSeconds)
import Control.Monad (void)
import Xmobar.Plugins.Monitors.Cpu.Common (CpuData(..))
#if defined(freebsd_HOST_OS)
import qualified Xmobar.Plugins.Monitors.Cpu.FreeBSD as MC
#else
import qualified Xmobar.Plugins.Monitors.Cpu.Linux as MC
#endif
newtype CpuOpts = CpuOpts
{ CpuOpts -> Maybe IconPattern
loadIconPattern :: Maybe IconPattern
}
defaultOpts :: CpuOpts
defaultOpts :: CpuOpts
defaultOpts = CpuOpts
{ loadIconPattern :: Maybe IconPattern
loadIconPattern = Maybe IconPattern
forall a. Maybe a
Nothing
}
options :: [OptDescr (CpuOpts -> CpuOpts)]
options :: [OptDescr (CpuOpts -> CpuOpts)]
options =
[ String
-> [String]
-> ArgDescr (CpuOpts -> CpuOpts)
-> String
-> OptDescr (CpuOpts -> CpuOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"" [String
"load-icon-pattern"] ((String -> CpuOpts -> CpuOpts)
-> String -> ArgDescr (CpuOpts -> CpuOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
x CpuOpts
o ->
CpuOpts
o { loadIconPattern = Just $ parseIconPattern x }) String
"") String
""
]
barField :: String
barField :: String
barField = String
"bar"
vbarField :: String
vbarField :: String
vbarField = String
"vbar"
ipatField :: String
ipatField :: String
ipatField = String
"ipat"
totalField :: String
totalField :: String
totalField = String
"total"
userField :: String
userField :: String
userField = String
"user"
niceField :: String
niceField :: String
niceField = String
"nice"
systemField :: String
systemField :: String
systemField = String
"system"
idleField :: String
idleField :: String
idleField = String
"idle"
iowaitField :: String
iowaitField :: String
iowaitField = String
"iowait"
cpuConfig :: IO MConfig
cpuConfig :: IO MConfig
cpuConfig =
String -> [String] -> IO MConfig
mkMConfig
String
"Cpu: <total>%"
[ String
barField
, String
vbarField
, String
ipatField
, String
totalField
, String
userField
, String
niceField
, String
systemField
, String
idleField
, String
iowaitField
]
data Field = Field {
Field -> String
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
$c== :: Field -> Field -> Bool
== :: Field -> Field -> Bool
$c/= :: Field -> Field -> Bool
/= :: 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
$ccompare :: Field -> Field -> Ordering
compare :: Field -> Field -> Ordering
$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
>= :: Field -> Field -> Bool
$cmax :: Field -> Field -> Field
max :: Field -> Field -> Field
$cmin :: Field -> Field -> Field
min :: Field -> Field -> Field
Ord, Int -> Field -> ShowS
[Field] -> ShowS
Field -> String
(Int -> Field -> ShowS)
-> (Field -> String) -> ([Field] -> ShowS) -> Show Field
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Field -> ShowS
showsPrec :: Int -> Field -> ShowS
$cshow :: Field -> String
show :: Field -> String
$cshowList :: [Field] -> ShowS
showList :: [Field] -> ShowS
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
$c== :: ShouldCompute -> ShouldCompute -> Bool
== :: ShouldCompute -> ShouldCompute -> Bool
$c/= :: ShouldCompute -> ShouldCompute -> Bool
/= :: 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
$ccompare :: ShouldCompute -> ShouldCompute -> Ordering
compare :: ShouldCompute -> ShouldCompute -> Ordering
$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
>= :: ShouldCompute -> ShouldCompute -> Bool
$cmax :: ShouldCompute -> ShouldCompute -> ShouldCompute
max :: ShouldCompute -> ShouldCompute -> ShouldCompute
$cmin :: ShouldCompute -> ShouldCompute -> ShouldCompute
min :: ShouldCompute -> ShouldCompute -> ShouldCompute
Ord, Int -> ShouldCompute -> ShowS
[ShouldCompute] -> ShowS
ShouldCompute -> String
(Int -> ShouldCompute -> ShowS)
-> (ShouldCompute -> String)
-> ([ShouldCompute] -> ShowS)
-> Show ShouldCompute
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ShouldCompute -> ShowS
showsPrec :: Int -> ShouldCompute -> ShowS
$cshow :: ShouldCompute -> String
show :: ShouldCompute -> String
$cshowList :: [ShouldCompute] -> ShowS
showList :: [ShouldCompute] -> ShowS
Show)
formatField :: MonitorConfig -> CpuOpts -> CpuData -> Field -> IO String
formatField :: MonitorConfig -> CpuOpts -> CpuData -> Field -> IO String
formatField MonitorConfig
cpuParams CpuOpts
cpuOpts cpuInfo :: CpuData
cpuInfo@CpuData {Float
cpuUser :: Float
cpuNice :: Float
cpuSystem :: Float
cpuIdle :: Float
cpuIowait :: Float
cpuTotal :: Float
cpuTotal :: CpuData -> Float
cpuIowait :: CpuData -> Float
cpuIdle :: CpuData -> Float
cpuSystem :: CpuData -> Float
cpuNice :: CpuData -> Float
cpuUser :: CpuData -> Float
..} Field {String
ShouldCompute
fieldName :: Field -> String
fieldCompute :: Field -> ShouldCompute
fieldName :: String
fieldCompute :: ShouldCompute
..}
| String
fieldName String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
barField =
if ShouldCompute
fieldCompute ShouldCompute -> ShouldCompute -> Bool
forall a. Eq a => a -> a -> Bool
== ShouldCompute
Compute
then MonitorConfig -> Float -> Float -> IO String
forall (m :: * -> *).
MonadIO m =>
MonitorConfig -> Float -> Float -> m String
pShowPercentBar MonitorConfig
cpuParams (Float
100 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
cpuTotal) Float
cpuTotal
else String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
| String
fieldName String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
vbarField =
if ShouldCompute
fieldCompute ShouldCompute -> ShouldCompute -> Bool
forall a. Eq a => a -> a -> Bool
== ShouldCompute
Compute
then MonitorConfig -> Float -> Float -> IO String
forall (m :: * -> *).
MonadIO m =>
MonitorConfig -> Float -> Float -> m String
pShowVerticalBar MonitorConfig
cpuParams (Float
100 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
cpuTotal) Float
cpuTotal
else String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
| String
fieldName String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
ipatField =
if ShouldCompute
fieldCompute ShouldCompute -> ShouldCompute -> Bool
forall a. Eq a => a -> a -> Bool
== ShouldCompute
Compute
then Maybe IconPattern -> Float -> IO String
pShowIconPattern (CpuOpts -> Maybe IconPattern
loadIconPattern CpuOpts
cpuOpts) Float
cpuTotal
else String -> IO String
forall a. a -> IO a
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 String
forall (m :: * -> *).
MonadIO m =>
MonitorConfig -> Float -> m String
pShowPercentWithColors MonitorConfig
cpuParams (String -> CpuData -> Float
getFieldValue String
fieldName CpuData
cpuInfo)
else String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
getFieldValue :: String -> CpuData -> Float
getFieldValue :: String -> CpuData -> Float
getFieldValue String
field CpuData{Float
cpuTotal :: CpuData -> Float
cpuIowait :: CpuData -> Float
cpuIdle :: CpuData -> Float
cpuSystem :: CpuData -> Float
cpuNice :: CpuData -> Float
cpuUser :: CpuData -> Float
cpuUser :: Float
cpuNice :: Float
cpuSystem :: Float
cpuIdle :: Float
cpuIowait :: Float
cpuTotal :: Float
..}
| String
field String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
barField = Float
cpuTotal
| String
field String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
vbarField = Float
cpuTotal
| String
field String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
ipatField = Float
cpuTotal
| String
field String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
totalField = Float
cpuTotal
| String
field String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
userField = Float
cpuUser
| String
field String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
niceField = Float
cpuNice
| String
field String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
systemField = Float
cpuSystem
| String
field String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
idleField = Float
cpuIdle
| Bool
otherwise = Float
cpuIowait
computeFields :: [String] -> [String] -> [Field]
computeFields :: [String] -> [String] -> [Field]
computeFields [] [String]
_ = []
computeFields (String
x:[String]
xs) [String]
inputFields =
if String
x String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
inputFields
then (Field {fieldName :: String
fieldName = String
x, fieldCompute :: ShouldCompute
fieldCompute = ShouldCompute
Compute}) Field -> [Field] -> [Field]
forall a. a -> [a] -> [a]
:
[String] -> [String] -> [Field]
computeFields [String]
xs [String]
inputFields
else (Field {fieldName :: String
fieldName = String
x, fieldCompute :: ShouldCompute
fieldCompute = ShouldCompute
Skip}) Field -> [Field] -> [Field]
forall a. a -> [a] -> [a]
:
[String] -> [String] -> [Field]
computeFields [String]
xs [String]
inputFields
formatCpu :: CpuArguments -> CpuData -> IO [String]
formatCpu :: CpuArguments -> CpuData -> IO [String]
formatCpu CpuArguments{[String]
[(String, [(String, String, String)])]
[(String, String, String)]
[Field]
CpuDataRef
MonitorConfig
CpuOpts
cpuDataRef :: CpuDataRef
cpuParams :: MonitorConfig
cpuArgs :: [String]
cpuOpts :: CpuOpts
cpuInputTemplate :: [(String, String, String)]
cpuAllTemplate :: [(String, [(String, String, String)])]
cpuFields :: [Field]
cpuFields :: CpuArguments -> [Field]
cpuAllTemplate :: CpuArguments -> [(String, [(String, String, String)])]
cpuInputTemplate :: CpuArguments -> [(String, String, String)]
cpuOpts :: CpuArguments -> CpuOpts
cpuArgs :: CpuArguments -> [String]
cpuParams :: CpuArguments -> MonitorConfig
cpuDataRef :: CpuArguments -> CpuDataRef
..} CpuData
cpuInfo = do
strs <- (Field -> IO String) -> [Field] -> 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 (MonitorConfig -> CpuOpts -> CpuData -> Field -> IO String
formatField MonitorConfig
cpuParams CpuOpts
cpuOpts CpuData
cpuInfo) [Field]
cpuFields
pure $ filter (not . null) strs
getInputFields :: CpuArguments -> [String]
getInputFields :: CpuArguments -> [String]
getInputFields CpuArguments{[String]
[(String, [(String, String, String)])]
[(String, String, String)]
[Field]
CpuDataRef
MonitorConfig
CpuOpts
cpuFields :: CpuArguments -> [Field]
cpuAllTemplate :: CpuArguments -> [(String, [(String, String, String)])]
cpuInputTemplate :: CpuArguments -> [(String, String, String)]
cpuOpts :: CpuArguments -> CpuOpts
cpuArgs :: CpuArguments -> [String]
cpuParams :: CpuArguments -> MonitorConfig
cpuDataRef :: CpuArguments -> CpuDataRef
cpuDataRef :: CpuDataRef
cpuParams :: MonitorConfig
cpuArgs :: [String]
cpuOpts :: CpuOpts
cpuInputTemplate :: [(String, String, String)]
cpuAllTemplate :: [(String, [(String, String, String)])]
cpuFields :: [Field]
..} = ((String, String, String) -> String)
-> [(String, String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
_,String
f,String
_) -> String
f) [(String, String, String)]
cpuInputTemplate
optimizeAllTemplate :: CpuArguments -> CpuArguments
optimizeAllTemplate :: CpuArguments -> CpuArguments
optimizeAllTemplate args :: CpuArguments
args@CpuArguments {[String]
[(String, [(String, String, String)])]
[(String, String, String)]
[Field]
CpuDataRef
MonitorConfig
CpuOpts
cpuFields :: CpuArguments -> [Field]
cpuAllTemplate :: CpuArguments -> [(String, [(String, String, String)])]
cpuInputTemplate :: CpuArguments -> [(String, String, String)]
cpuOpts :: CpuArguments -> CpuOpts
cpuArgs :: CpuArguments -> [String]
cpuParams :: CpuArguments -> MonitorConfig
cpuDataRef :: CpuArguments -> CpuDataRef
cpuDataRef :: CpuDataRef
cpuParams :: MonitorConfig
cpuArgs :: [String]
cpuOpts :: CpuOpts
cpuInputTemplate :: [(String, String, String)]
cpuAllTemplate :: [(String, [(String, String, String)])]
cpuFields :: [Field]
..} =
let inputFields :: [String]
inputFields = CpuArguments -> [String]
getInputFields CpuArguments
args
allTemplates :: [(String, [(String, String, String)])]
allTemplates =
((String, [(String, String, String)]) -> Bool)
-> [(String, [(String, String, String)])]
-> [(String, [(String, String, String)])]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(String
field, [(String, String, String)]
_) -> String
field String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
inputFields) [(String, [(String, String, String)])]
cpuAllTemplate
in CpuArguments
args {cpuAllTemplate = allTemplates}
data CpuArguments =
CpuArguments
{ CpuArguments -> CpuDataRef
cpuDataRef :: !MC.CpuDataRef
, CpuArguments -> MonitorConfig
cpuParams :: !MonitorConfig
, CpuArguments -> [String]
cpuArgs :: ![String]
, CpuArguments -> CpuOpts
cpuOpts :: !CpuOpts
, CpuArguments -> [(String, String, String)]
cpuInputTemplate :: ![(String, String, String)]
, CpuArguments -> [(String, [(String, String, String)])]
cpuAllTemplate :: ![(String, [(String, String, String)])]
, CpuArguments -> [Field]
cpuFields :: ![Field]
}
getArguments :: [String] -> IO CpuArguments
getArguments :: [String] -> IO CpuArguments
getArguments [String]
cpuArgs = do
initCpuData <- IO [Int]
MC.cpuData
cpuDataRef <- newIORef initCpuData
void $ MC.parseCpu cpuDataRef
cpuParams <- computeMonitorConfig cpuArgs cpuConfig
cpuInputTemplate <- runTemplateParser cpuParams
cpuAllTemplate <- runExportParser (pExport cpuParams)
nonOptions <-
case getOpt Permute pluginOptions cpuArgs of
([Opts]
_, [String]
n, []) -> [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [String]
n
([Opts]
_, [String]
_, [String]
errs) -> String -> IO [String]
forall a. HasCallStack => String -> a
error (String -> IO [String]) -> String -> IO [String]
forall a b. (a -> b) -> a -> b
$ String
"getArguments: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [String] -> String
forall a. Show a => a -> String
show [String]
errs
cpuOpts <-
case getOpt Permute options nonOptions of
([CpuOpts -> CpuOpts]
o, [String]
_, []) -> CpuOpts -> IO CpuOpts
forall a. a -> IO a
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 a b. (a -> b -> b) -> b -> [a] -> b
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]
_, [String]
_, [String]
errs) -> String -> IO CpuOpts
forall a. HasCallStack => String -> a
error (String -> IO CpuOpts) -> String -> IO CpuOpts
forall a b. (a -> b) -> a -> b
$ String
"getArguments options: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [String] -> String
forall a. Show a => a -> String
show [String]
errs
let cpuFields =
[String] -> [String] -> [Field]
computeFields
(((String, [(String, String, String)]) -> String)
-> [(String, [(String, String, String)])] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, [(String, String, String)]) -> String
forall a b. (a, b) -> a
fst [(String, [(String, String, String)])]
cpuAllTemplate)
(((String, String, String) -> String)
-> [(String, String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
_, String
f, String
_) -> String
f) [(String, String, String)]
cpuInputTemplate)
pure $ optimizeAllTemplate CpuArguments {..}
runCpu :: CpuArguments -> IO String
runCpu :: CpuArguments -> IO String
runCpu args :: CpuArguments
args@CpuArguments {[String]
[(String, [(String, String, String)])]
[(String, String, String)]
[Field]
CpuDataRef
MonitorConfig
CpuOpts
cpuFields :: CpuArguments -> [Field]
cpuAllTemplate :: CpuArguments -> [(String, [(String, String, String)])]
cpuInputTemplate :: CpuArguments -> [(String, String, String)]
cpuOpts :: CpuArguments -> CpuOpts
cpuArgs :: CpuArguments -> [String]
cpuParams :: CpuArguments -> MonitorConfig
cpuDataRef :: CpuArguments -> CpuDataRef
cpuDataRef :: CpuDataRef
cpuParams :: MonitorConfig
cpuArgs :: [String]
cpuOpts :: CpuOpts
cpuInputTemplate :: [(String, String, String)]
cpuAllTemplate :: [(String, [(String, String, String)])]
cpuFields :: [Field]
..} = do
cpuValue <- CpuDataRef -> IO CpuData
MC.parseCpu CpuDataRef
cpuDataRef
temMonitorValues <- formatCpu args cpuValue
let templateInput =
TemplateInput
{ temInputTemplate :: [(String, String, String)]
temInputTemplate = [(String, String, String)]
cpuInputTemplate
, temAllTemplate :: [(String, [(String, String, String)])]
temAllTemplate = [(String, [(String, String, String)])]
cpuAllTemplate
, [String]
temMonitorValues :: [String]
temMonitorValues :: [String]
..
}
pureParseTemplate cpuParams templateInput
startCpu :: [String] -> Int -> (String -> IO ()) -> IO ()
startCpu :: [String] -> Int -> (String -> IO ()) -> IO ()
startCpu [String]
args Int
refreshRate String -> IO ()
cb = do
cpuArgs <- [String] -> IO CpuArguments
getArguments [String]
args
doEveryTenthSeconds refreshRate (runCpu cpuArgs >>= cb)