From 4c1a6b350095e671eea5a4963e6b82997c5098fc Mon Sep 17 00:00:00 2001 From: Martin Perner Date: Thu, 21 Jul 2011 18:13:32 +0200 Subject: DateZone: Added plugin for localized date --- src/Plugins/DateZone.hs | 44 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 44 insertions(+) create mode 100644 src/Plugins/DateZone.hs (limited to 'src/Plugins') diff --git a/src/Plugins/DateZone.hs b/src/Plugins/DateZone.hs new file mode 100644 index 0000000..4d5ce6a --- /dev/null +++ b/src/Plugins/DateZone.hs @@ -0,0 +1,44 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Plugins.DateZone +-- Copyright : (c) Martin Perner +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Martin Perner +-- Stability : unstable +-- Portability : unportable +-- +-- A date plugin with localization support for Xmobar +-- +-- Based on Plugins.Date +-- +-- Usage example: in template put +-- +-- > Run DateZone "%H:%M:%S" "utcDate" "UTC" 10 +-- +----------------------------------------------------------------------------- + +module Plugins.DateZone (DateZone(..)) where + +import Plugins + +import System.Locale + +import Data.Time.LocalTime +import Data.Time.Format +import Data.Time.LocalTime.TimeZone.Olson +import Data.Time.LocalTime.TimeZone.Series + +data DateZone = DateZone String String String Int + deriving (Read, Show) + +instance Exec DateZone where + alias (DateZone _ a _ _) = a + run (DateZone f _ z _) = date f z + rate (DateZone _ _ _ r) = r + +date :: String -> String -> IO String +date format zone = do + timeZone <- getTimeZoneSeriesFromOlsonFile ("/usr/share/zoneinfo/" ++ zone) + zonedTime <- getZonedTime + return $ formatTime defaultTimeLocale format $ utcToLocalTime' timeZone $ zonedTimeToUTC zonedTime -- cgit v1.2.3 From 231dd1f10834b7651bbec226c821a53087d10084 Mon Sep 17 00:00:00 2001 From: Sergei Trofimovich Date: Fri, 22 Jul 2011 12:36:06 +0300 Subject: fix build failure against ghc-7.2 src/Plugins/Monitors/Top.hs:140:17: Illegal bang-pattern (use -XBangPatterns): ! r Signed-off-by: Sergei Trofimovich --- src/Plugins/Monitors/Top.hs | 1 + 1 file changed, 1 insertion(+) (limited to 'src/Plugins') 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 -- cgit v1.2.3 From eab5960f5d2d6bd15119ff8f613b8d8f2df88287 Mon Sep 17 00:00:00 2001 From: Norbert Zeh Date: Mon, 8 Aug 2011 17:40:04 -0300 Subject: Cope with new file system layout of CPU temperature sensor readings Either due to a change in lm_sensors or in the kernel itself, the core temperature readings are no longer found in one directory per core but in multiple files in the same directory. What's worse is that the file names have little to do with the actual core number. This patch addresses this and is flexible enough to handle the old layout and the new one. --- src/Plugins/Monitors/CoreCommon.hs | 151 +++++++++++++++++++++++++++---------- src/Plugins/Monitors/CoreTemp.hs | 12 ++- src/Plugins/Monitors/CpuFreq.hs | 18 ++--- 3 files changed, 125 insertions(+), 56 deletions(-) (limited to 'src/Plugins') 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 -- cgit v1.2.3