1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
|
-----------------------------------------------------------------------------
-- |
-- 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 { maxIconPattern :: Maybe IconPattern
, avgIconPattern :: Maybe IconPattern
, mintemp :: Float
, maxtemp :: Float
, hwMonitorPath :: Maybe String
}
-- | Set default Options.
defaultOpts :: CTOpts
defaultOpts = CTOpts { maxIconPattern = Nothing
, avgIconPattern = Nothing
, mintemp = 0
, maxtemp = 100
, hwMonitorPath = Nothing
}
-- | Apply configured Options.
options :: [OptDescr (CTOpts -> CTOpts)]
options = [ Option [] ["max-icon-pattern"]
(ReqArg
(\ arg opts -> opts { maxIconPattern = Just $ parseIconPattern arg })
"")
""
, Option [] ["avg-icon-pattern"]
(ReqArg
(\ arg opts -> opts { avgIconPattern = Just $ parseIconPattern arg })
"")
""
, Option [] ["mintemp"]
(ReqArg
(\ arg opts -> opts { mintemp = read arg })
"")
""
, Option [] ["maxtemp"]
(ReqArg
(\ arg opts -> opts { maxtemp = read arg })
"")
""
, Option [] ["hwmon-path"]
(ReqArg
(\ arg opts -> opts { hwMonitorPath = Just arg })
"")
""
]
-- | Generate Config with a default template and options.
cTConfig :: IO MConfig
cTConfig = mkMConfig cTTemplate cTOptions
where cTTemplate = "Temp: <max>°C - <maxpc>%"
cTOptions = [ "max" , "maxpc" , "maxbar" , "maxvbar" , "maxipat"
, "avg" , "avgpc" , "avgbar" , "avgvbar" , "avgipat"
] ++ map (("core" ++) . show) [0 :: Int ..]
-- | Returns the first coretemp.N path found.
coretempPath :: IO (Maybe String)
coretempPath = do xs <- filterM doesDirectoryExist ps
return (if null xs then Nothing else Just $ head xs)
where ps = [ "/sys/bus/platform/devices/coretemp." ++ show (x :: Int) ++ "/"
| x <- [0..9] ]
-- | Returns the first hwmonN in coretemp path found or the ones in sys/class.
hwmonPaths :: IO [String]
hwmonPaths = do p <- coretempPath
let (sc, path) = case p of
Just s -> (False, s)
Nothing -> (True, "/sys/class/")
let cps = [ path ++ "hwmon/hwmon" ++ show (x :: Int) ++ "/"
| x <- [0..9] ]
ecps <- filterM doesDirectoryExist cps
return $ if sc || null ecps then ecps else [head ecps]
-- | Checks Labels, if they refer to a core and returns Strings of core-
-- temperatures.
corePaths :: Maybe String -> IO [String]
corePaths s = do ps <- case s of
Just pth -> return [pth]
_ -> hwmonPaths
let cps = [p ++ "temp" ++ show (x :: Int) ++ "_label"
| x <- [0..9], p <- ps ]
ls <- filterM doesFileExist cps
cls <- filterM isLabelFromCore ls
return $ map labelToCore cls
-- | Checks if Label refers to a core.
isLabelFromCore :: FilePath -> IO Bool
isLabelFromCore p = do a <- readFile p
return $ take 4 a `elem` ["Core", "Tdie", "Tctl"]
-- | Transform a path to Label to a path to core-temperature.
labelToCore :: FilePath -> FilePath
labelToCore = (++ "input") . reverse . drop 5 . reverse
-- | Reads core-temperatures as data from the system.
cTData :: Maybe String -> IO [Float]
cTData p = do fps <- corePaths p
traverse readSingleFile fps
where readSingleFile :: FilePath -> IO Float
readSingleFile s = do a <- readFile s
return $ parseContent a
where parseContent :: String -> Float
parseContent = read . head . lines
-- | Transforms data of temperatures into temperatures of degree Celsius.
parseCT :: CTOpts -> IO [Float]
parseCT opts = do rawCTs <- cTData (hwMonitorPath opts)
let normalizedCTs = map (/ 1000) rawCTs :: [Float]
return normalizedCTs
-- | Performs calculation for maximum and average.
-- Sets up Bars and Values to be printed.
formatCT :: CTOpts -> [Float] -> Monitor [String]
formatCT opts cTs = do let CTOpts { mintemp = minT
, maxtemp = maxT } = opts
domainT = maxT - minT
maxCT = maximum cTs
avgCT = sum cTs / fromIntegral (length cTs)
calcPc t = (t - minT) / domainT
maxCTPc = calcPc maxCT
avgCTPc = calcPc avgCT
cs <- traverse showTempWithColors cTs
m <- showTempWithColors maxCT
mp <- showWithColors' (show (round (100*maxCTPc) :: Int)) maxCT
mb <- showPercentBar maxCT maxCTPc
mv <- showVerticalBar maxCT maxCTPc
mi <- showIconPattern (maxIconPattern opts) maxCTPc
a <- showTempWithColors avgCT
ap <- showWithColors' (show (round (100*avgCTPc) :: Int)) avgCT
ab <- showPercentBar avgCT avgCTPc
av <- showVerticalBar avgCT avgCTPc
ai <- showIconPattern (avgIconPattern opts) avgCTPc
let ms = [ m , mp , mb , mv , mi ]
as = [ a , ap , ab , av , ai ]
return (ms ++ as ++ cs)
where showTempWithColors :: Float -> Monitor String
showTempWithColors = showWithColors (show . (round :: Float -> Int))
runCT :: [String] -> Monitor String
runCT argv = do opts <- io $ parseOptsWith options defaultOpts argv
cTs <- io $ parseCT opts
l <- formatCT opts cTs
parseTemplate l
startMultiCoreTemp :: [String] -> Int -> (String -> IO ()) -> IO ()
startMultiCoreTemp a = runM a cTConfig runCT
|
