diff options
| -rw-r--r-- | src/Plugins/Monitors/CoreCommon.hs | 151 | ||||
| -rw-r--r-- | src/Plugins/Monitors/CoreTemp.hs | 12 | ||||
| -rw-r--r-- | src/Plugins/Monitors/CpuFreq.hs | 18 |
3 files changed, 125 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 |