module Xmobar.Plugins.Monitors.MultiCoreTemp (startMultiCoreTemp) where
import Xmobar.Plugins.Monitors.Common
import Control.Monad (filterM)
import System.Console.GetOpt
import System.Directory ( doesDirectoryExist
, doesFileExist
)
data CTOpts = CTOpts { CTOpts -> Maybe IconPattern
maxIconPattern :: Maybe IconPattern
, CTOpts -> Maybe IconPattern
avgIconPattern :: Maybe IconPattern
, CTOpts -> Float
mintemp :: Float
, CTOpts -> Float
maxtemp :: Float
}
defaultOpts :: CTOpts
defaultOpts :: CTOpts
defaultOpts = CTOpts :: Maybe IconPattern -> Maybe IconPattern -> Float -> Float -> 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
}
options :: [OptDescr (CTOpts -> CTOpts)]
options :: [OptDescr (CTOpts -> CTOpts)]
options = [ [Char]
-> [[Char]]
-> ArgDescr (CTOpts -> CTOpts)
-> [Char]
-> OptDescr (CTOpts -> CTOpts)
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [] [[Char]
"max-icon-pattern"]
(([Char] -> CTOpts -> CTOpts)
-> [Char] -> ArgDescr (CTOpts -> CTOpts)
forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg
(\ [Char]
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
$ [Char] -> IconPattern
parseIconPattern [Char]
arg })
[Char]
"")
[Char]
""
, [Char]
-> [[Char]]
-> ArgDescr (CTOpts -> CTOpts)
-> [Char]
-> OptDescr (CTOpts -> CTOpts)
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [] [[Char]
"avg-icon-pattern"]
(([Char] -> CTOpts -> CTOpts)
-> [Char] -> ArgDescr (CTOpts -> CTOpts)
forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg
(\ [Char]
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
$ [Char] -> IconPattern
parseIconPattern [Char]
arg })
[Char]
"")
[Char]
""
, [Char]
-> [[Char]]
-> ArgDescr (CTOpts -> CTOpts)
-> [Char]
-> OptDescr (CTOpts -> CTOpts)
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [] [[Char]
"mintemp"]
(([Char] -> CTOpts -> CTOpts)
-> [Char] -> ArgDescr (CTOpts -> CTOpts)
forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg
(\ [Char]
arg CTOpts
opts -> CTOpts
opts { mintemp :: Float
mintemp = [Char] -> Float
forall a. Read a => [Char] -> a
read [Char]
arg })
[Char]
"")
[Char]
""
, [Char]
-> [[Char]]
-> ArgDescr (CTOpts -> CTOpts)
-> [Char]
-> OptDescr (CTOpts -> CTOpts)
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [] [[Char]
"maxtemp"]
(([Char] -> CTOpts -> CTOpts)
-> [Char] -> ArgDescr (CTOpts -> CTOpts)
forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg
(\ [Char]
arg CTOpts
opts -> CTOpts
opts { maxtemp :: Float
maxtemp = [Char] -> Float
forall a. Read a => [Char] -> a
read [Char]
arg })
[Char]
"")
[Char]
""
]
cTConfig :: IO MConfig
cTConfig :: IO MConfig
cTConfig = [Char] -> [[Char]] -> IO MConfig
mkMConfig [Char]
cTTemplate [[Char]]
cTOptions
where cTTemplate :: [Char]
cTTemplate = [Char]
"Temp: <max>°C - <maxpc>%"
cTOptions :: [[Char]]
cTOptions = [ [Char]
"max" , [Char]
"maxpc" , [Char]
"maxbar" , [Char]
"maxvbar" , [Char]
"maxipat"
, [Char]
"avg" , [Char]
"avgpc" , [Char]
"avgbar" , [Char]
"avgvbar" , [Char]
"avgipat"
] [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ IconPattern -> [Int] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (([Char]
"core" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) ([Char] -> [Char]) -> IconPattern -> IconPattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IconPattern
forall a. Show a => a -> [Char]
show) [Int
0 :: Int ..]
coretempPath :: IO String
coretempPath :: IO [Char]
coretempPath = do [[Char]]
xs <- ([Char] -> IO Bool) -> [[Char]] -> IO [[Char]]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM [Char] -> IO Bool
doesDirectoryExist [[Char]]
ps
let x :: [Char]
x = [[Char]] -> [Char]
forall a. [a] -> a
head [[Char]]
xs
[Char] -> IO [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
x
where ps :: [[Char]]
ps = [ [Char]
"/sys/bus/platform/devices/coretemp." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ IconPattern
forall a. Show a => a -> [Char]
show (Int
x :: Int) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"/" | Int
x <- [Int
0..Int
9] ]
hwmonPath :: IO String
hwmonPath :: IO [Char]
hwmonPath = do [Char]
p <- IO [Char]
coretempPath
[[Char]]
xs <- ([Char] -> IO Bool) -> [[Char]] -> IO [[Char]]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM [Char] -> IO Bool
doesDirectoryExist [ [Char]
p [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"hwmon/hwmon" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ IconPattern
forall a. Show a => a -> [Char]
show (Int
x :: Int) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"/" | Int
x <- [Int
0..Int
9] ]
let x :: [Char]
x = [[Char]] -> [Char]
forall a. [a] -> a
head [[Char]]
xs
[Char] -> IO [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
x
corePaths :: IO [String]
corePaths :: IO [[Char]]
corePaths = do [Char]
p <- IO [Char]
hwmonPath
[[Char]]
ls <- ([Char] -> IO Bool) -> [[Char]] -> IO [[Char]]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM [Char] -> IO Bool
doesFileExist [ [Char]
p [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"temp" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ IconPattern
forall a. Show a => a -> [Char]
show (Int
x :: Int) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"_label" | Int
x <- [Int
0..Int
9] ]
[[Char]]
cls <- ([Char] -> IO Bool) -> [[Char]] -> IO [[Char]]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM [Char] -> IO Bool
isLabelFromCore [[Char]]
ls
[[Char]] -> IO [[Char]]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Char]] -> IO [[Char]]) -> [[Char]] -> IO [[Char]]
forall a b. (a -> b) -> a -> b
$ ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [Char]
labelToCore [[Char]]
cls
isLabelFromCore :: FilePath -> IO Bool
isLabelFromCore :: [Char] -> IO Bool
isLabelFromCore [Char]
p = do [Char]
a <- [Char] -> IO [Char]
readFile [Char]
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 -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
4 [Char]
a [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"Core"
labelToCore :: FilePath -> FilePath
labelToCore :: [Char] -> [Char]
labelToCore = ([Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"input") ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
forall a. [a] -> [a]
reverse ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
5 ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
forall a. [a] -> [a]
reverse
cTData :: IO [Float]
cTData :: IO [Float]
cTData = do [[Char]]
fps <- IO [[Char]]
corePaths
([Char] -> IO Float) -> [[Char]] -> IO [Float]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse [Char] -> IO Float
readSingleFile [[Char]]
fps
where readSingleFile :: FilePath -> IO Float
readSingleFile :: [Char] -> IO Float
readSingleFile [Char]
s = do [Char]
a <- [Char] -> IO [Char]
readFile [Char]
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
$ [Char] -> Float
parseContent [Char]
a
where parseContent :: String -> Float
parseContent :: [Char] -> Float
parseContent = [Char] -> Float
forall a. Read a => [Char] -> a
read ([Char] -> Float) -> ([Char] -> [Char]) -> [Char] -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [Char]
forall a. [a] -> a
head ([[Char]] -> [Char]) -> ([Char] -> [[Char]]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
lines
parseCT :: IO [Float]
parseCT :: IO [Float]
parseCT = do [Float]
rawCTs <- IO [Float]
cTData
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 [[Char]]
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
[[Char]]
cs <- (Float -> ReaderT MConfig IO [Char]) -> [Float] -> Monitor [[Char]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Float -> ReaderT MConfig IO [Char]
showTempWithColors [Float]
cTs
[Char]
m <- Float -> ReaderT MConfig IO [Char]
showTempWithColors Float
maxCT
[Char]
mp <- [Char] -> Float -> ReaderT MConfig IO [Char]
forall a.
(Num a, Ord a) =>
[Char] -> a -> ReaderT MConfig IO [Char]
showWithColors' (IconPattern
forall a. Show a => a -> [Char]
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
[Char]
mb <- Float -> Float -> ReaderT MConfig IO [Char]
showPercentBar Float
maxCT Float
maxCTPc
[Char]
mv <- Float -> Float -> ReaderT MConfig IO [Char]
showVerticalBar Float
maxCT Float
maxCTPc
[Char]
mi <- Maybe IconPattern -> Float -> ReaderT MConfig IO [Char]
showIconPattern (CTOpts -> Maybe IconPattern
maxIconPattern CTOpts
opts) Float
maxCTPc
[Char]
a <- Float -> ReaderT MConfig IO [Char]
showTempWithColors Float
avgCT
[Char]
ap <- [Char] -> Float -> ReaderT MConfig IO [Char]
forall a.
(Num a, Ord a) =>
[Char] -> a -> ReaderT MConfig IO [Char]
showWithColors' (IconPattern
forall a. Show a => a -> [Char]
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
[Char]
ab <- Float -> Float -> ReaderT MConfig IO [Char]
showPercentBar Float
avgCT Float
avgCTPc
[Char]
av <- Float -> Float -> ReaderT MConfig IO [Char]
showVerticalBar Float
avgCT Float
avgCTPc
[Char]
ai <- Maybe IconPattern -> Float -> ReaderT MConfig IO [Char]
showIconPattern (CTOpts -> Maybe IconPattern
avgIconPattern CTOpts
opts) Float
avgCTPc
let ms :: [[Char]]
ms = [ [Char]
m , [Char]
mp , [Char]
mb , [Char]
mv , [Char]
mi ]
as :: [[Char]]
as = [ [Char]
a , [Char]
ap , [Char]
ab , [Char]
av , [Char]
ai ]
[[Char]] -> Monitor [[Char]]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Char]]
ms [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
as [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
cs)
where showTempWithColors :: Float -> Monitor String
showTempWithColors :: Float -> ReaderT MConfig IO [Char]
showTempWithColors = (Float -> [Char]) -> Float -> ReaderT MConfig IO [Char]
forall a.
(Num a, Ord a) =>
(a -> [Char]) -> a -> ReaderT MConfig IO [Char]
showWithColors (IconPattern
forall a. Show a => a -> [Char]
show IconPattern -> (Float -> Int) -> Float -> [Char]
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 :: [[Char]] -> ReaderT MConfig IO [Char]
runCT [[Char]]
argv = do [Float]
cTs <- IO [Float] -> Monitor [Float]
forall a. IO a -> Monitor a
io IO [Float]
parseCT
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 -> [[Char]] -> IO CTOpts
forall opts.
[OptDescr (opts -> opts)] -> opts -> [[Char]] -> IO opts
parseOptsWith [OptDescr (CTOpts -> CTOpts)]
options CTOpts
defaultOpts [[Char]]
argv
[[Char]]
l <- CTOpts -> [Float] -> Monitor [[Char]]
formatCT CTOpts
opts [Float]
cTs
[[Char]] -> ReaderT MConfig IO [Char]
parseTemplate [[Char]]
l
startMultiCoreTemp :: [String] -> Int -> (String -> IO ()) -> IO ()
startMultiCoreTemp :: [[Char]] -> Int -> ([Char] -> IO ()) -> IO ()
startMultiCoreTemp [[Char]]
a = [[Char]]
-> IO MConfig
-> ([[Char]] -> ReaderT MConfig IO [Char])
-> Int
-> ([Char] -> IO ())
-> IO ()
runM [[Char]]
a IO MConfig
cTConfig [[Char]] -> ReaderT MConfig IO [Char]
runCT