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
|
-----------------------------------------------------------------------------
-- |
-- Module : Plugins.Monitors.MultiCoreTemp
-- Copyright : (c) 2019 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
}
-- | Set default Options.
defaultOpts :: CTOpts
defaultOpts = CTOpts { maxIconPattern = Nothing
, avgIconPattern = Nothing
, mintemp = 0
, maxtemp = 100
}
-- | 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 })
"")
""
]
-- | Parse Arguments and apply them to Options.
parseOpts :: [String] -> IO CTOpts
parseOpts argv = case getOpt Permute options argv of
(opts , _ , [] ) -> return $ foldr id defaultOpts opts
(_ , _ , errs) -> ioError . userError $ concat errs
-- | 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 String
coretempPath = do xs <- filterM doesDirectoryExist ps
let x = head xs
return x
where ps = [ "/sys/bus/platform/devices/coretemp." ++ show (x :: Int) ++ "/" | x <- [0..9] ]
-- | Returns the first hwmonN path found.
hwmonPath :: IO String
hwmonPath = do p <- coretempPath
xs <- filterM doesDirectoryExist [ p ++ "hwmon/hwmon" ++ show (x :: Int) ++ "/" | x <- [0..9] ]
let x = head xs
return x
-- | Checks Labels, if they refer to a core and returns Strings of core-
-- temperatures.
corePaths :: IO [String]
corePaths = do p <- hwmonPath
ls <- filterM doesFileExist [ p ++ "temp" ++ show (x :: Int) ++ "_label" | x <- [0..9] ]
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 == "Core"
-- | 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 :: IO [Float]
cTData = do fps <- corePaths
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 :: IO [Float]
parseCT = do rawCTs <- cTData
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 cTs <- io parseCT
opts <- io $ parseOpts argv
l <- formatCT opts cTs
parseTemplate l
startMultiCoreTemp :: [String] -> Int -> (String -> IO ()) -> IO ()
startMultiCoreTemp a = runM a cTConfig runCT
|
