-----------------------------------------------------------------------------
-- |
-- Module      :  Plugins.Monitors.MultiCoreTemp
-- Copyright   :  (c) 2019, 2020 Felix Springer
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Felix Springer <felixspringer149@gmail.com>
-- Stability   :  unstable
-- Portability :  unportable
--
-- A core temperature monitor for Xmobar
--
-----------------------------------------------------------------------------

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
                        )

-- | Declare Options.
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
                     }

-- | Set default Options.
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
                     }

-- | Apply configured Options.
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
""
          ]

-- | Generate Config with a default template and options.
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 ..]


-- | Returns the first coretemp.N path found.
coretempPath :: IO (Maybe String)
coretempPath :: IO (Maybe String)
coretempPath = do [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)
  where ps :: [String]
ps = [ String
"/sys/bus/platform/devices/coretemp." String -> String -> String
forall a. [a] -> [a] -> [a]
++ IconPattern
forall a. Show a => a -> String
show (Int
x :: Int) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/"
             | Int
x <- [Int
0..Int
9] ]

-- | Returns the first hwmonN in coretemp path found or the ones in sys/class.
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/")
                let cps :: [String]
cps  = [ String
path String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"hwmon/hwmon" String -> String -> String
forall a. [a] -> [a] -> [a]
++ IconPattern
forall a. Show a => a -> String
show (Int
x :: Int) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/"
                           | Int
x <- [Int
0..Int
9] ]
                [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]

-- | Checks Labels, if they refer to a core and returns Strings of core-
-- temperatures.
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
                 let cps :: [String]
cps = [String
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"temp" String -> String -> String
forall a. [a] -> [a] -> [a]
++ IconPattern
forall a. Show a => a -> String
show (Int
x :: Int) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_label"
                           | Int
x <- [Int
0..Int
9], String
p <- [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

-- | Checks if Label refers to a core.
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"]

-- | Transform a path to Label to a path to core-temperature.
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

-- | Reads core-temperatures as data from the system.
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

-- | Transforms data of temperatures into temperatures of degree Celsius.
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

-- | Performs calculation for maximum and average.
-- Sets up Bars and Values to be printed.
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