summaryrefslogtreecommitdiffhomepage
path: root/src/Plugins/Monitors
diff options
context:
space:
mode:
Diffstat (limited to 'src/Plugins/Monitors')
-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/Top.hs1
4 files changed, 126 insertions, 56 deletions
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/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-12-26 07:38:08 +0000