From 2a005217151dbfff86c3d4a478ee8d305d04eb4c Mon Sep 17 00:00:00 2001 From: Norbert Zeh Date: Mon, 21 Feb 2011 19:58:26 -0400 Subject: Fixed math in Command.tenthSeconds --- src/Commands.hs | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/src/Commands.hs b/src/Commands.hs index 38d0aed..1bfbb94 100644 --- a/src/Commands.hs +++ b/src/Commands.hs @@ -75,8 +75,7 @@ instance Exec Command where -- is not possible to set a thread delay grater than about 45 minutes. -- With a little recursion we solve the problem. tenthSeconds :: Int -> IO () -tenthSeconds s | s >= x = do threadDelay y - tenthSeconds (x - s) +tenthSeconds s | s >= x = do threadDelay (x * 100000) + tenthSeconds (s - x) | otherwise = threadDelay (s * 100000) - where y = maxBound :: Int - x = y `div` 100000 + where x = (maxBound :: Int) `div` 100000 -- cgit v1.2.3 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 --- README | 14 ++++++++++++++ src/Config.hs | 7 +++++++ src/Plugins/DateZone.hs | 44 ++++++++++++++++++++++++++++++++++++++++++++ xmobar.cabal | 9 +++++++++ 4 files changed, 74 insertions(+) create mode 100644 src/Plugins/DateZone.hs diff --git a/README b/README index 2253c1f..626130d 100644 --- a/README +++ b/README @@ -124,6 +124,10 @@ Otherwise, you'll need to install them yourself. : Support for ALSA sound cards. Enables the Volume plugin. Requires the [alsa-mixer] package. +`with_datezone` +: Support for localized times. Enables the DateZone plugin. Requires + [timezone-olson] and [timezone-series] package. + `all_extensions` : Enables all the extensions above. @@ -846,6 +850,16 @@ can be used in the output template as `%mydate%` `strftime` function (or Haskell's `formatCalendarTime`). - Sample usage: `Run Date "%a %b %_d %Y %H:%M:%S" "date" 10` +`Date Format Alias Zone RefreshRate` + +- Format is a time format string, as accepted by the standard ISO C + `strftime` function (or Haskell's `formatCalendarTime`). +- Zone is the name of the TimeZone. Assumes that the tz database is stored in + /usr/share/zoneinfo/ +- Sample usage: + `Run DateZone "%H:%M:%S" "viennaDate" "Europa/Vienna" 10` + + `CommandReader "/path/to/program" Alias` - Runs the given program, and displays its standard output. diff --git a/src/Config.hs b/src/Config.hs index 6eb55a0..3184023 100644 --- a/src/Config.hs +++ b/src/Config.hs @@ -38,6 +38,10 @@ import Plugins.Mail import Plugins.MBox #endif +#ifdef DATEZONE +import Plugins.DateZone +#endif + -- $config -- Configuration data type and default configuration @@ -111,6 +115,9 @@ infixr :*: runnableTypes :: Command :*: Monitors :*: Date :*: PipeReader :*: CommandReader :*: StdinReader :*: XMonadLog :*: EWMH :*: #ifdef INOTIFY Mail :*: MBox :*: +#endif +#ifdef DATEZONE + DateZone :*: #endif () runnableTypes = undefined 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 diff --git a/xmobar.cabal b/xmobar.cabal index abdf136..ecafe1d 100644 --- a/xmobar.cabal +++ b/xmobar.cabal @@ -57,6 +57,10 @@ flag with_alsa description: Use alsa-mixer to get the volume from soundcards. default: False +flag with_datezone + description: Enables localized date support + default: False + executable xmobar hs-source-dirs: src main-is: Main.hs @@ -120,3 +124,8 @@ executable xmobar build-depends: alsa-mixer == 0.1.* other-modules: Plugins.Monitors.Volume cpp-options: -DALSA + + if flag(with_datezone) || flag(all_extensions) + build-depends: timezone-olson, timezone-series + other-modules: Plugins.DateZone + cpp-options: -DDATEZONE -- 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(+) 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(-) 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