module Xmobar.Plugins.Monitors.MultiCoreTemp (startMultiCoreTemp) where
import Xmobar.Plugins.Monitors.Common
import Control.Monad (filterM)
import Data.Char (isDigit)
import Data.List (isPrefixOf)
import System.Console.GetOpt
import System.Directory ( doesDirectoryExist
, doesFileExist
, listDirectory
)
data CTOpts = CTOpts { CTOpts -> Maybe IconPattern
maxIconPattern :: Maybe IconPattern
, CTOpts -> Maybe IconPattern
avgIconPattern :: Maybe IconPattern
, CTOpts -> Float
mintemp :: Float
, CTOpts -> Float
maxtemp :: Float
, CTOpts -> Maybe String
hwMonitorPath :: Maybe String
}
defaultOpts :: CTOpts
defaultOpts :: CTOpts
defaultOpts = CTOpts :: Maybe IconPattern
-> Maybe IconPattern -> Float -> Float -> Maybe String -> CTOpts
CTOpts { maxIconPattern :: Maybe IconPattern
maxIconPattern = Maybe IconPattern
forall a. Maybe a
Nothing
, avgIconPattern :: Maybe IconPattern
avgIconPattern = Maybe IconPattern
forall a. Maybe a
Nothing
, mintemp :: Float
mintemp = Float
0
, maxtemp :: Float
maxtemp = Float
100
, hwMonitorPath :: Maybe String
hwMonitorPath = Maybe String
forall a. Maybe a
Nothing
}
options :: [OptDescr (CTOpts -> CTOpts)]
options :: [OptDescr (CTOpts -> CTOpts)]
options = [ String
-> [String]
-> ArgDescr (CTOpts -> CTOpts)
-> String
-> OptDescr (CTOpts -> CTOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"max-icon-pattern"]
((String -> CTOpts -> CTOpts)
-> String -> ArgDescr (CTOpts -> CTOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg
(\ String
arg CTOpts
opts -> CTOpts
opts { maxIconPattern :: Maybe IconPattern
maxIconPattern = IconPattern -> Maybe IconPattern
forall a. a -> Maybe a
Just (IconPattern -> Maybe IconPattern)
-> IconPattern -> Maybe IconPattern
forall a b. (a -> b) -> a -> b
$ String -> IconPattern
parseIconPattern String
arg })
String
"")
String
""
, String
-> [String]
-> ArgDescr (CTOpts -> CTOpts)
-> String
-> OptDescr (CTOpts -> CTOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"avg-icon-pattern"]
((String -> CTOpts -> CTOpts)
-> String -> ArgDescr (CTOpts -> CTOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg
(\ String
arg CTOpts
opts -> CTOpts
opts { avgIconPattern :: Maybe IconPattern
avgIconPattern = IconPattern -> Maybe IconPattern
forall a. a -> Maybe a
Just (IconPattern -> Maybe IconPattern)
-> IconPattern -> Maybe IconPattern
forall a b. (a -> b) -> a -> b
$ String -> IconPattern
parseIconPattern String
arg })
String
"")
String
""
, String
-> [String]
-> ArgDescr (CTOpts -> CTOpts)
-> String
-> OptDescr (CTOpts -> CTOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"mintemp"]
((String -> CTOpts -> CTOpts)
-> String -> ArgDescr (CTOpts -> CTOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg
(\ String
arg CTOpts
opts -> CTOpts
opts { mintemp :: Float
mintemp = String -> Float
forall a. Read a => String -> a
read String
arg })
String
"")
String
""
, String
-> [String]
-> ArgDescr (CTOpts -> CTOpts)
-> String
-> OptDescr (CTOpts -> CTOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"maxtemp"]
((String -> CTOpts -> CTOpts)
-> String -> ArgDescr (CTOpts -> CTOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg
(\ String
arg CTOpts
opts -> CTOpts
opts { maxtemp :: Float
maxtemp = String -> Float
forall a. Read a => String -> a
read String
arg })
String
"")
String
""
, String
-> [String]
-> ArgDescr (CTOpts -> CTOpts)
-> String
-> OptDescr (CTOpts -> CTOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"hwmon-path"]
((String -> CTOpts -> CTOpts)
-> String -> ArgDescr (CTOpts -> CTOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg
(\ String
arg CTOpts
opts -> CTOpts
opts { hwMonitorPath :: Maybe String
hwMonitorPath = String -> Maybe String
forall a. a -> Maybe a
Just String
arg })
String
"")
String
""
]
cTConfig :: IO MConfig
cTConfig :: IO MConfig
cTConfig = String -> [String] -> IO MConfig
mkMConfig String
cTTemplate [String]
cTOptions
where cTTemplate :: String
cTTemplate = String
"Temp: <max>°C - <maxpc>%"
cTOptions :: [String]
cTOptions = [ String
"max" , String
"maxpc" , String
"maxbar" , String
"maxvbar" , String
"maxipat"
, String
"avg" , String
"avgpc" , String
"avgbar" , String
"avgvbar" , String
"avgipat"
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ IconPattern -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((String
"core" String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> IconPattern -> IconPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IconPattern
forall a. Show a => a -> String
show) [Int
0 :: Int ..]
getMatchingPathsInDir :: FilePath -> (String -> Bool) -> IO [FilePath]
getMatchingPathsInDir :: String -> (String -> Bool) -> IO [String]
getMatchingPathsInDir String
dir String -> Bool
f = do Bool
exists <- String -> IO Bool
doesDirectoryExist String
dir
if Bool
exists
then do
[String]
files <- (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
f ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
listDirectory String
dir
[String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\String
file -> String
dir String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file) [String]
files
else [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return []
numberedPathMatcher :: String -> String -> String -> Bool
numberedPathMatcher :: String -> String -> String -> Bool
numberedPathMatcher String
prefix String
suffix String
path =
String
prefix String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
path
Bool -> Bool -> Bool
&& Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
digits)
Bool -> Bool -> Bool
&& String
afterDigits String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
suffix
where afterPrefix :: String
afterPrefix = Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
prefix) String
path
digits :: String
digits = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
isDigit String
afterPrefix
afterDigits :: String
afterDigits = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isDigit String
afterPrefix
coretempPath :: IO (Maybe String)
coretempPath :: IO (Maybe String)
coretempPath = do [String]
ps <- String -> (String -> Bool) -> IO [String]
getMatchingPathsInDir String
"/sys/bus/platform/devices" String -> Bool
coretempMatcher
[String]
xs <- (String -> IO Bool) -> [String] -> IO [String]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM String -> IO Bool
doesDirectoryExist [String]
ps
Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
xs then Maybe String
forall a. Maybe a
Nothing else String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. [a] -> a
head [String]
xs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/")
where coretempMatcher :: String -> Bool
coretempMatcher = String -> String -> String -> Bool
numberedPathMatcher String
"coretemp." String
""
hwmonPaths :: IO [String]
hwmonPaths :: IO [String]
hwmonPaths = do Maybe String
p <- IO (Maybe String)
coretempPath
let (Bool
sc, String
path) = case Maybe String
p of
Just String
s -> (Bool
False, String
s)
Maybe String
Nothing -> (Bool
True, String
"/sys/class/")
[String]
cps <- String -> (String -> Bool) -> IO [String]
getMatchingPathsInDir (String
path String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"hwmon") String -> Bool
hwmonMatcher
[String]
ecps <- (String -> IO Bool) -> [String] -> IO [String]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM String -> IO Bool
doesDirectoryExist [String]
cps
[String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ if Bool
sc Bool -> Bool -> Bool
|| [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
ecps then [String]
ecps else [[String] -> String
forall a. [a] -> a
head [String]
ecps]
where hwmonMatcher :: String -> Bool
hwmonMatcher = String -> String -> String -> Bool
numberedPathMatcher String
"hwmon" String
""
corePaths :: Maybe String -> IO [String]
corePaths :: Maybe String -> IO [String]
corePaths Maybe String
s = do [String]
ps <- case Maybe String
s of
Just String
pth -> [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String
pth]
Maybe String
_ -> IO [String]
hwmonPaths
[String]
cps <- [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String]) -> IO [[String]] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> IO [String]) -> [String] -> IO [[String]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (String -> (String -> Bool) -> IO [String]
`getMatchingPathsInDir` String -> Bool
corePathMatcher) [String]
ps
[String]
ls <- (String -> IO Bool) -> [String] -> IO [String]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM String -> IO Bool
doesFileExist [String]
cps
[String]
cls <- (String -> IO Bool) -> [String] -> IO [String]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM String -> IO Bool
isLabelFromCore [String]
ls
[String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
labelToCore [String]
cls
where corePathMatcher :: String -> Bool
corePathMatcher = String -> String -> String -> Bool
numberedPathMatcher String
"temp" String
"_label"
isLabelFromCore :: FilePath -> IO Bool
isLabelFromCore :: String -> IO Bool
isLabelFromCore String
p = do String
a <- String -> IO String
readFile String
p
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
4 String
a String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"Core", String
"Tdie", String
"Tctl"]
labelToCore :: FilePath -> FilePath
labelToCore :: String -> String
labelToCore = (String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"input") (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
5 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse
cTData :: Maybe String -> IO [Float]
cTData :: Maybe String -> IO [Float]
cTData Maybe String
p = do [String]
fps <- Maybe String -> IO [String]
corePaths Maybe String
p
(String -> IO Float) -> [String] -> IO [Float]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse String -> IO Float
readSingleFile [String]
fps
where readSingleFile :: FilePath -> IO Float
readSingleFile :: String -> IO Float
readSingleFile String
s = do String
a <- String -> IO String
readFile String
s
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
$ String -> Float
parseContent String
a
where parseContent :: String -> Float
parseContent :: String -> Float
parseContent = String -> Float
forall a. Read a => String -> a
read (String -> Float) -> (String -> String) -> String -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall a. [a] -> a
head ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
parseCT :: CTOpts -> IO [Float]
parseCT :: CTOpts -> IO [Float]
parseCT CTOpts
opts = do [Float]
rawCTs <- Maybe String -> IO [Float]
cTData (CTOpts -> Maybe String
hwMonitorPath CTOpts
opts)
let normalizedCTs :: [Float]
normalizedCTs = (Float -> Float) -> [Float] -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map (Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
1000) [Float]
rawCTs :: [Float]
[Float] -> IO [Float]
forall (m :: * -> *) a. Monad m => a -> m a
return [Float]
normalizedCTs
formatCT :: CTOpts -> [Float] -> Monitor [String]
formatCT :: CTOpts -> [Float] -> Monitor [String]
formatCT CTOpts
opts [Float]
cTs = do let CTOpts { mintemp :: CTOpts -> Float
mintemp = Float
minT
, maxtemp :: CTOpts -> Float
maxtemp = Float
maxT } = CTOpts
opts
domainT :: Float
domainT = Float
maxT Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
minT
maxCT :: Float
maxCT = [Float] -> Float
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Float]
cTs
avgCT :: Float
avgCT = [Float] -> Float
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Float]
cTs Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Float] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Float]
cTs)
calcPc :: Float -> Float
calcPc Float
t = (Float
t Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
minT) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
domainT
maxCTPc :: Float
maxCTPc = Float -> Float
calcPc Float
maxCT
avgCTPc :: Float
avgCTPc = Float -> Float
calcPc Float
avgCT
[String]
cs <- (Float -> ReaderT MConfig IO String) -> [Float] -> Monitor [String]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Float -> ReaderT MConfig IO String
showTempWithColors [Float]
cTs
String
m <- Float -> ReaderT MConfig IO String
showTempWithColors Float
maxCT
String
mp <- String -> Float -> ReaderT MConfig IO String
forall a.
(Num a, Ord a) =>
String -> a -> ReaderT MConfig IO String
showWithColors' (IconPattern
forall a. Show a => a -> String
show (Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Float
100Float -> Float -> Float
forall a. Num a => a -> a -> a
*Float
maxCTPc) :: Int)) Float
maxCT
String
mb <- Float -> Float -> ReaderT MConfig IO String
showPercentBar Float
maxCT Float
maxCTPc
String
mv <- Float -> Float -> ReaderT MConfig IO String
showVerticalBar Float
maxCT Float
maxCTPc
String
mi <- Maybe IconPattern -> Float -> ReaderT MConfig IO String
showIconPattern (CTOpts -> Maybe IconPattern
maxIconPattern CTOpts
opts) Float
maxCTPc
String
a <- Float -> ReaderT MConfig IO String
showTempWithColors Float
avgCT
String
ap <- String -> Float -> ReaderT MConfig IO String
forall a.
(Num a, Ord a) =>
String -> a -> ReaderT MConfig IO String
showWithColors' (IconPattern
forall a. Show a => a -> String
show (Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Float
100Float -> Float -> Float
forall a. Num a => a -> a -> a
*Float
avgCTPc) :: Int)) Float
avgCT
String
ab <- Float -> Float -> ReaderT MConfig IO String
showPercentBar Float
avgCT Float
avgCTPc
String
av <- Float -> Float -> ReaderT MConfig IO String
showVerticalBar Float
avgCT Float
avgCTPc
String
ai <- Maybe IconPattern -> Float -> ReaderT MConfig IO String
showIconPattern (CTOpts -> Maybe IconPattern
avgIconPattern CTOpts
opts) Float
avgCTPc
let ms :: [String]
ms = [ String
m , String
mp , String
mb , String
mv , String
mi ]
as :: [String]
as = [ String
a , String
ap , String
ab , String
av , String
ai ]
[String] -> Monitor [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String]
ms [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
as [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
cs)
where showTempWithColors :: Float -> Monitor String
showTempWithColors :: Float -> ReaderT MConfig IO String
showTempWithColors = (Float -> String) -> Float -> ReaderT MConfig IO String
forall a.
(Num a, Ord a) =>
(a -> String) -> a -> ReaderT MConfig IO String
showWithColors (IconPattern
forall a. Show a => a -> String
show IconPattern -> (Float -> Int) -> Float -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round :: Float -> Int))
runCT :: [String] -> Monitor String
runCT :: [String] -> ReaderT MConfig IO String
runCT [String]
argv = do CTOpts
opts <- IO CTOpts -> Monitor CTOpts
forall a. IO a -> Monitor a
io (IO CTOpts -> Monitor CTOpts) -> IO CTOpts -> Monitor CTOpts
forall a b. (a -> b) -> a -> b
$ [OptDescr (CTOpts -> CTOpts)] -> CTOpts -> [String] -> IO CTOpts
forall opts.
[OptDescr (opts -> opts)] -> opts -> [String] -> IO opts
parseOptsWith [OptDescr (CTOpts -> CTOpts)]
options CTOpts
defaultOpts [String]
argv
[Float]
cTs <- IO [Float] -> Monitor [Float]
forall a. IO a -> Monitor a
io (IO [Float] -> Monitor [Float]) -> IO [Float] -> Monitor [Float]
forall a b. (a -> b) -> a -> b
$ CTOpts -> IO [Float]
parseCT CTOpts
opts
[String]
l <- CTOpts -> [Float] -> Monitor [String]
formatCT CTOpts
opts [Float]
cTs
[String] -> ReaderT MConfig IO String
parseTemplate [String]
l
startMultiCoreTemp :: [String] -> Int -> (String -> IO ()) -> IO ()
startMultiCoreTemp :: [String] -> Int -> (String -> IO ()) -> IO ()
startMultiCoreTemp [String]
a = [String]
-> IO MConfig
-> ([String] -> ReaderT MConfig IO String)
-> Int
-> (String -> IO ())
-> IO ()
runM [String]
a IO MConfig
cTConfig [String] -> ReaderT MConfig IO String
runCT