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
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
|
-----------------------------------------------------------------------------
-- |
-- 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 Data.Char (isDigit)
import Data.List (isPrefixOf)
import System.Console.GetOpt
import System.Directory ( doesDirectoryExist
, doesFileExist
, listDirectory
)
-- | 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 all paths in dir matching the predicate.
getMatchingPathsInDir :: FilePath -> (String -> Bool) -> IO [FilePath]
getMatchingPathsInDir dir f = do exists <- doesDirectoryExist dir
if exists
then do
files <- filter f <$> listDirectory dir
return $ fmap (\file -> dir ++ "/" ++ file) files
else return []
-- | Given a prefix, suffix, and path string, return true if the path string
-- format is prefix ++ numeric ++ suffix.
numberedPathMatcher :: String -> String -> String -> Bool
numberedPathMatcher prefix suffix path =
prefix `isPrefixOf` path
&& not (null digits)
&& afterDigits == suffix
where afterPrefix = drop (length prefix) path
digits = takeWhile isDigit afterPrefix
afterDigits = dropWhile isDigit afterPrefix
-- | Returns the first coretemp.N path found.
coretempPath :: IO (Maybe String)
coretempPath = do ps <- getMatchingPathsInDir "/sys/bus/platform/devices" coretempMatcher
xs <- filterM doesDirectoryExist ps
return (if null xs then Nothing else Just $ head xs ++ "/")
where coretempMatcher = numberedPathMatcher "coretemp." ""
-- | 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/")
cps <- getMatchingPathsInDir (path ++ "hwmon") hwmonMatcher
ecps <- filterM doesDirectoryExist cps
return $ if sc || null ecps then ecps else [head ecps]
where hwmonMatcher = numberedPathMatcher "hwmon" ""
-- | 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
cps <- concat <$> traverse (`getMatchingPathsInDir` corePathMatcher) ps
ls <- filterM doesFileExist cps
cls <- filterM isLabelFromCore ls
return $ map labelToCore cls
where corePathMatcher = numberedPathMatcher "temp" "_label"
-- | 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
|
