summaryrefslogtreecommitdiffhomepage
path: root/src/Plugins/Monitors
diff options
context:
space:
mode:
Diffstat (limited to 'src/Plugins/Monitors')
-rw-r--r--src/Plugins/Monitors/Batt.hs10
-rw-r--r--src/Plugins/Monitors/Bright.hs118
-rw-r--r--src/Plugins/Monitors/CoreCommon.hs151
-rw-r--r--src/Plugins/Monitors/CoreTemp.hs12
-rw-r--r--src/Plugins/Monitors/CpuFreq.hs18
-rw-r--r--src/Plugins/Monitors/MPD.hs13
-rw-r--r--src/Plugins/Monitors/ThermalZone.hs43
-rw-r--r--src/Plugins/Monitors/Top.hs1
8 files changed, 295 insertions, 71 deletions
diff --git a/src/Plugins/Monitors/Batt.hs b/src/Plugins/Monitors/Batt.hs
index 7d4242a..c276e6b 100644
--- a/src/Plugins/Monitors/Batt.hs
+++ b/src/Plugins/Monitors/Batt.hs
@@ -123,18 +123,20 @@ readBattery files =
return $ Battery (3600 * a / 1000000) -- wattseconds
(3600 * b / 1000000) -- wattseconds
(c / 1000000) -- volts
- (d / c) -- amperes
- where grab = fmap (read . B.unpack) . B.readFile
+ (if c > 0 then (d / c) else -1) -- amperes
+ where grab f = catch (fmap (read . B.unpack) $ B.readFile f) (\_ -> return 0)
readBatteries :: BattOpts -> [Files] -> IO Result
readBatteries opts bfs =
do bats <- mapM readBattery (take 3 bfs)
ac <- haveAc (onlineFile opts)
let sign = if ac then 1 else -1
- left = sum (map now bats) / sum (map full bats)
+ ft = sum (map full bats)
+ left = if ft > 0 then sum (map now bats) / ft else 0
watts = sign * sum (map voltage bats) * sum (map current bats)
time = if watts == 0 then 0 else sum $ map time' bats
- time' b = (if ac then full b - now b else now b) / (sign * watts)
+ mwatts = if watts == 0 then 1 else sign * watts
+ time' b = (if ac then full b - now b else now b) / mwatts
acstr = if ac then onString opts else offString opts
return $ if isNaN left then NA else Result left watts time acstr
diff --git a/src/Plugins/Monitors/Bright.hs b/src/Plugins/Monitors/Bright.hs
new file mode 100644
index 0000000..499e5bc
--- /dev/null
+++ b/src/Plugins/Monitors/Bright.hs
@@ -0,0 +1,118 @@
+-----------------------------------------------------------------------------
+---- |
+---- Module : Plugins.Monitors.Birght
+---- Copyright : (c) Martin Perner
+---- License : BSD-style (see LICENSE)
+----
+---- Maintainer : Martin Perner <martin@perner.cc>
+---- Stability : unstable
+---- Portability : unportable
+----
+---- A screen brightness monitor for Xmobar
+----
+-------------------------------------------------------------------------------
+
+module Plugins.Monitors.Bright (brightConfig, runBright) where
+
+import Plugins.Monitors.Common
+import qualified Data.ByteString.Lazy.Char8 as B
+import Data.Char
+import System.FilePath ((</>))
+import System.Posix.Files (fileExist)
+import System.Console.GetOpt
+
+data BrightOpts = BrightOpts
+ { subDir :: String
+ , currBright :: String
+ , maxBright :: String
+ }
+
+defaultOpts :: BrightOpts
+defaultOpts = BrightOpts
+ { subDir = "acpi_video0"
+ , currBright = "actual_brightness"
+ , maxBright = "max_brightness"
+ }
+
+options :: [OptDescr (BrightOpts -> BrightOpts)]
+options =
+ [ Option "D" ["device"] (ReqArg (\x o -> o { subDir = x }) "") ""
+ , Option "C" ["curr"] (ReqArg (\x o -> o { currBright = x }) "") ""
+ , Option "M" ["max"] (ReqArg (\x o -> o { maxBright = x }) "") ""
+ ]
+
+-- from Batt.hs
+parseOpts :: [String] -> IO BrightOpts
+parseOpts argv =
+ case getOpt Permute options argv of
+ (o, _, []) -> return $ foldr id defaultOpts o
+ (_, _, errs) -> ioError . userError $ concat errs
+
+sysDir :: FilePath
+sysDir = "/sys/class/backlight/"
+
+brightConfig :: IO MConfig
+brightConfig = mkMConfig
+ "<percent>" -- template
+ ["hbar", "percent", "bar"] -- replacements
+
+data Files = Files
+ { fCurr :: String
+ , fMax :: String
+ } | NoFiles
+
+brightFiles :: BrightOpts -> IO Files
+brightFiles opts =
+ do
+ is_curr <- fileExist $ (fCurr files)
+ is_max <- fileExist $ (fCurr files)
+ if is_curr && is_max
+ then return files
+ else return NoFiles
+ where
+ prefix = sysDir </> (subDir opts)
+ files = Files { fCurr = prefix </> (currBright opts)
+ , fMax = prefix </> (maxBright opts)
+ }
+
+
+runBright :: [String] -> Monitor String
+runBright args = do
+ opts <- io $ parseOpts args
+ f <- io $ brightFiles opts
+ c <- io $ readBright f
+ case f of
+ NoFiles -> return "hurz"
+ _ -> do x <- fmtPercent c
+ parseTemplate (x)
+ where
+ fmtPercent :: Float -> Monitor [String]
+ fmtPercent c = do
+ r <- showHorizontalBar (100 * c)
+ s <- showPercentWithColors c
+ t <- showPercentBar (100 * c) c
+ return [r,s,t]
+
+readBright :: Files -> IO Float
+readBright NoFiles = return 0
+readBright files =
+ do
+ currVal<- grab $ (fCurr files)
+ maxVal <- grab $ (fMax files)
+ return $ (currVal / maxVal)
+ where
+ grab f = catch (fmap (read . B.unpack) $ B.readFile f)(\_ -> return 0)
+
+
+showHorizontalBar :: Float -> Monitor String
+showHorizontalBar x = do
+ return $ [convert x]
+ where
+ convert :: Float -> Char
+ convert val
+ | t <= 9600 = ' '
+ | t > 9608 = chr 9608
+ | otherwise = chr t
+ where
+ -- we scale from 0 to 100, we have 8 slots (9 elements), 100/8 = 12
+ t = 9600 + ((round val) `div` 12)
diff --git a/src/Plugins/Monitors/CoreCommon.hs b/src/Plugins/Monitors/CoreCommon.hs
index 80e7700..e508f7d 100644
--- a/src/Plugins/Monitors/CoreCommon.hs
+++ b/src/Plugins/Monitors/CoreCommon.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE PatternGuards #-}
+
-----------------------------------------------------------------------------
-- |
-- Module : Plugins.Monitors.CoreCommon
@@ -14,46 +16,119 @@
module Plugins.Monitors.CoreCommon where
+import Control.Applicative
+import Control.Monad
+import Data.Char hiding (Space)
+import Data.Function
+import Data.List
+import Data.Maybe
import Plugins.Monitors.Common
-import System.Posix.Files (fileExist)
-import System.IO (withFile, IOMode(ReadMode), hGetLine)
import System.Directory
-import Data.Char (isDigit)
-import Data.List (isPrefixOf)
--- |
--- Function checks the existence of first file specified by pattern and if the
--- file doesn't exists failure message is shown, otherwise the data retrieval
--- is performed.
-checkedDataRetrieval :: (Num a, Ord a, Show a) =>
- String -> String -> String -> String -> (Double -> a)
- -> (a -> String) -> Monitor String
-checkedDataRetrieval failureMessage dir file pattern trans fmt = do
- exists <- io $ fileExist $ concat [dir, "/", pattern, "0/", file]
- case exists of
- False -> return failureMessage
- True -> retrieveData dir file pattern trans fmt
+checkedDataRetrieval :: (Ord a, Num a)
+ => String -> [String] -> Maybe (String, String -> Int)
+ -> (Double -> a) -> (a -> String) -> Monitor String
+checkedDataRetrieval msg path lbl trans fmt = liftM (maybe msg id) $
+ retrieveData path lbl trans fmt
--- |
--- Function retrieves data from files in directory dir specified by
--- pattern. String values are converted to double and 'trans' applied
--- to each one. Final array is processed by template parser function
--- and returned as monitor string.
-retrieveData :: (Num a, Ord a, Show a) =>
- String -> String -> String -> (Double -> a) -> (a -> String) ->
- Monitor String
-retrieveData dir file pattern trans fmt = do
- count <- io $ dirCount dir pattern
- contents <- io $ mapM getGuts $ files count
- values <- mapM (showWithColors fmt) $ map conversion contents
- parseTemplate values
- where
- getGuts f = withFile f ReadMode hGetLine
- dirCount path str = getDirectoryContents path
- >>= return . length
- . filter (\s -> str `isPrefixOf` s
- && isDigit (last s))
- files count = map (\i -> concat [dir, "/", pattern, show i, "/", file])
- [0 .. count - 1]
- conversion = trans . (read :: String -> Double)
+retrieveData :: (Ord a, Num a)
+ => [String] -> Maybe (String, String -> Int)
+ -> (Double -> a) -> (a -> String) -> Monitor (Maybe String)
+retrieveData path lbl trans fmt = do
+ pairs <- map snd . sortBy (compare `on` fst) <$> (mapM readFiles =<< findFiles path lbl)
+ if null pairs
+ then return Nothing
+ else Just <$> ( parseTemplate
+ =<< mapM (showWithColors fmt . trans . read) pairs
+ )
+
+-- | Represents the different types of path components
+data Comp = Fix String
+ | Var [String]
+ deriving Show
+
+-- | Used to represent parts of file names separated by slashes and spaces
+data CompOrSep = Slash
+ | Space
+ | Comp String
+ deriving (Eq, Show)
+
+-- | Function to turn a list of of strings into a list of path components
+pathComponents :: [String] -> [Comp]
+pathComponents = joinComps . drop 2 . concat . intersperse [Space] . map splitParts
+ where
+ splitParts p | (l, _:r) <- break (== '/') p = (Comp l):Slash:splitParts r
+ | otherwise = [Comp p]
+
+ joinComps = uncurry joinComps' . partition isComp
+
+ isComp (Comp _) = True
+ isComp _ = False
+
+ fromComp (Comp s) = s
+ fromComp _ = error "fromComp applied to value other than (Comp _)"
+
+ joinComps' cs [] = [Fix $ fromComp $ head cs] -- cs should have only one element here,
+ -- but this keeps the pattern matching
+ -- exhaustive
+ joinComps' cs (p:ps) = let (ss, ps') = span (== p) ps
+ ct = if null ps' || (p == Space) then length ss + 1
+ else length ss
+ (ls, rs) = splitAt (ct+1) cs
+ c = case p of
+ Space -> Var $ map fromComp ls
+ Slash -> Fix $ intercalate "/" $ map fromComp ls
+ _ -> error "Should not happen"
+ in if null ps' then [c]
+ else c:joinComps' rs (drop ct ps)
+
+-- | Function to find all files matching the given path and possible label file.
+-- The path must be absolute (start with a leading slash).
+findFiles :: [String] -> Maybe (String, String -> Int)
+ -> Monitor [(String, Either Int (String, String -> Int))]
+findFiles path lbl = catMaybes
+ <$> ( mapM addLabel . zip [0..] . sort
+ =<< recFindFiles (pathComponents path) "/"
+ )
+ where
+ addLabel (i, f) = maybe (return $ Just (f, Left i))
+ (\(s, t) -> justIfExists f s t)
+ lbl
+
+ justIfExists f s t = let f' = take (length f - length s) f ++ s
+ in ifthen (Just (f, Right (f', t))) Nothing <$> (io $ doesFileExist f')
+
+ recFindFiles [] d = ifthen [d] []
+ <$> (io $ if null d then return False else doesFileExist d)
+ recFindFiles ps d = ifthen (recFindFiles' ps d) (return [])
+ =<< (io $ if null d then return True else doesDirectoryExist d)
+
+ recFindFiles' [] _ = error "Should not happen"
+ recFindFiles' (Fix p:ps) d = recFindFiles ps (d ++ "/" ++ p)
+ recFindFiles' (Var p:ps) d = concat
+ <$> ( mapM (recFindFiles ps)
+ . map (\f -> d ++ "/" ++ f)
+ . filter (matchesVar p)
+ =<< (io $ getDirectoryContents d)
+ )
+
+ matchesVar [] _ = False
+ matchesVar [v] f = v == f
+ matchesVar (v:vs) f = let f' = drop (length v) f
+ f'' = dropWhile isDigit f'
+ in and [ v `isPrefixOf` f
+ , not (null f')
+ , isDigit (head f')
+ , matchesVar vs f''
+ ]
+
+-- | Function to read the contents of the given file(s)
+readFiles :: (String, Either Int (String, String -> Int))
+ -> Monitor (Int, String)
+readFiles (fval, flbl) = (,) <$> either return (\(f, ex) -> liftM ex
+ $ io $ readFile f) flbl
+ <*> (io $ readFile fval)
+-- | Function that captures if-then-else
+ifthen :: a -> a -> Bool -> a
+ifthen thn els cnd = if cnd then thn else els \ No newline at end of file
diff --git a/src/Plugins/Monitors/CoreTemp.hs b/src/Plugins/Monitors/CoreTemp.hs
index a24b284..f7b5c95 100644
--- a/src/Plugins/Monitors/CoreTemp.hs
+++ b/src/Plugins/Monitors/CoreTemp.hs
@@ -31,11 +31,9 @@ coreTempConfig = mkMConfig
-- Function retrieves monitor string holding the core temperature
-- (or temperatures)
runCoreTemp :: [String] -> Monitor String
-runCoreTemp _ = do
- let dir = "/sys/bus/platform/devices"
- file = "temp1_input"
- pattern = "coretemp."
- divisor = 1e3 :: Double
- failureMessage = "CoreTemp: N/A"
- checkedDataRetrieval failureMessage dir file pattern (/divisor) show
+runCoreTemp _ = let path = ["/sys/bus/platform/devices/coretemp.", "/temp", "_input"]
+ lbl = Just ("_label", read . drop 5)
+ divisor = 1e3 :: Double
+ failureMessage = "CoreTemp: N/A"
+ in checkedDataRetrieval failureMessage path lbl (/divisor) show
diff --git a/src/Plugins/Monitors/CpuFreq.hs b/src/Plugins/Monitors/CpuFreq.hs
index 4f01922..dcf75e5 100644
--- a/src/Plugins/Monitors/CpuFreq.hs
+++ b/src/Plugins/Monitors/CpuFreq.hs
@@ -28,16 +28,12 @@ cpuFreqConfig = mkMConfig
-- replacements
-- |
--- Function retrieves monitor string holding the cpu frequency (or
--- frequencies)
+-- Function retrieves monitor string holding the cpu frequency (or frequencies)
runCpuFreq :: [String] -> Monitor String
-runCpuFreq _ = do
- let dir = "/sys/devices/system/cpu"
- file = "cpufreq/scaling_cur_freq"
- pattern = "cpu"
- divisor = 1e6 :: Double
- failureMessage = "CpuFreq: N/A"
- fmt x | x < 1 = show (round (x * 1000) :: Integer) ++ "MHz"
- | otherwise = showDigits 1 x ++ "GHz"
- checkedDataRetrieval failureMessage dir file pattern (/divisor) fmt
+runCpuFreq _ = let path = ["/sys/devices/system/cpu/cpu", "/cpufreq/scaling_cur_freq"]
+ divisor = 1e6 :: Double
+ failureMessage = "CpuFreq: N/A"
+ fmt x | x < 1 = (show (round (x * 1000) :: Integer)) ++ "MHz"
+ | otherwise = (show x) ++ "GHz"
+ in checkedDataRetrieval failureMessage path Nothing (/divisor) fmt
diff --git a/src/Plugins/Monitors/MPD.hs b/src/Plugins/Monitors/MPD.hs
index daf0ed4..60c3e48 100644
--- a/src/Plugins/Monitors/MPD.hs
+++ b/src/Plugins/Monitors/MPD.hs
@@ -30,9 +30,6 @@ data MOpts = MOpts
{ mPlaying :: String
, mStopped :: String
, mPaused :: String
- , mHost :: String
- , mPort :: Integer
- , mPassword :: String
}
defaultOpts :: MOpts
@@ -40,9 +37,6 @@ defaultOpts = MOpts
{ mPlaying = ">>"
, mStopped = "><"
, mPaused = "||"
- , mHost = "127.0.0.1"
- , mPort = 6600
- , mPassword = ""
}
options :: [OptDescr (MOpts -> MOpts)]
@@ -50,15 +44,12 @@ options =
[ Option "P" ["playing"] (ReqArg (\x o -> o { mPlaying = x }) "") ""
, Option "S" ["stopped"] (ReqArg (\x o -> o { mStopped = x }) "") ""
, Option "Z" ["paused"] (ReqArg (\x o -> o { mPaused = x }) "") ""
- , Option "h" ["host"] (ReqArg (\x o -> o { mHost = x }) "") ""
- , Option "p" ["port"] (ReqArg (\x o -> o { mPort = read x }) "") ""
- , Option "x" ["password"] (ReqArg (\x o -> o { mPassword = x }) "") ""
]
runMPD :: [String] -> Monitor String
runMPD args = do
opts <- io $ mopts args
- let mpd = M.withMPDEx (mHost opts) (mPort opts) (mPassword opts)
+ let mpd = M.withMPD
status <- io $ mpd M.status
song <- io $ mpd M.currentSong
s <- parseMPD status song opts
@@ -100,7 +91,7 @@ parseSong (Right Nothing) = return $ repeat ""
parseSong (Right (Just s)) =
let join [] = ""
join (x:xs) = foldl (\a o -> a ++ ", " ++ o) x xs
- str sel = maybe "" join (M.sgGet sel s)
+ str sel = maybe "" join (M.sgGetTag sel s)
sels = [ M.Name, M.Artist, M.Composer, M.Performer
, M.Album, M.Title, M.Track, M.Genre ]
fields = M.sgFilePath s : map str sels
diff --git a/src/Plugins/Monitors/ThermalZone.hs b/src/Plugins/Monitors/ThermalZone.hs
new file mode 100644
index 0000000..55fb2ca
--- /dev/null
+++ b/src/Plugins/Monitors/ThermalZone.hs
@@ -0,0 +1,43 @@
+------------------------------------------------------------------------------
+-- |
+-- Module : Plugins.Monitors.ThermalZone
+-- Copyright : (c) 2011 Jose Antonio Ortega Ruiz
+-- License : BSD3-style (see LICENSE)
+--
+-- Maintainer : jao@gnu.org
+-- Stability : unstable
+-- Portability : portable
+-- Created : Fri Feb 25, 2011 03:18
+--
+--
+-- A thermal zone plugin based on the sysfs linux interface.
+-- See http://kernel.org/doc/Documentation/thermal/sysfs-api.txt
+--
+------------------------------------------------------------------------------
+
+module Plugins.Monitors.ThermalZone (thermalZoneConfig, runThermalZone) where
+
+import Plugins.Monitors.Common
+
+import System.Posix.Files (fileExist)
+import qualified Data.ByteString.Char8 as B
+
+-- | Default thermal configuration.
+thermalZoneConfig :: IO MConfig
+thermalZoneConfig = mkMConfig "<temp>C" ["temp"]
+
+-- | Retrieves thermal information. Argument is name of thermal
+-- directory in \/sys\/clas\/thermal. Returns the monitor string
+-- parsed according to template (either default or user specified).
+runThermalZone :: [String] -> Monitor String
+runThermalZone args = do
+ let zone = head args
+ file = "/sys/class/thermal/thermal_zone" ++ zone ++ "/temp"
+ parse = return . (read :: String -> Int) . B.unpack
+ exists <- io $ fileExist file
+ if exists
+ then do mdegrees <- io $ B.readFile file >>= parse
+ temp <- showWithColors show (mdegrees `quot` 1000)
+ parseTemplate [ temp ]
+ else return "N/A"
+
diff --git a/src/Plugins/Monitors/Top.hs b/src/Plugins/Monitors/Top.hs
index e45210c..6001164 100644
--- a/src/Plugins/Monitors/Top.hs
+++ b/src/Plugins/Monitors/Top.hs
@@ -13,6 +13,7 @@
-----------------------------------------------------------------------------
{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE BangPatterns #-}
module Plugins.Monitors.Top (startTop, topMemConfig, runTopMem) where
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-02 22:42:22 +0000