diff options
| -rw-r--r-- | README | 14 | ||||
| -rw-r--r-- | src/Commands.hs | 7 | ||||
| -rw-r--r-- | src/Config.hs | 7 | ||||
| -rw-r--r-- | src/Plugins/DateZone.hs | 44 | ||||
| -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 | ||||
| -rw-r--r-- | src/Plugins/Monitors/Top.hs | 1 | ||||
| -rw-r--r-- | xmobar.cabal | 9 |
9 files changed, 203 insertions, 60 deletions
@@ -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 <fc=#ee9a00>%H:%M:%S</fc>" "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 "<fc=#ee9a00>%H:%M:%S</fc>" "viennaDate" "Europa/Vienna" 10` + + `CommandReader "/path/to/program" Alias` - Runs the given program, and displays its standard output. 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 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 @@ -112,5 +116,8 @@ runnableTypes :: Command :*: Monitors :*: Date :*: PipeReader :*: CommandReader #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 <martin@perner.cc> +-- 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/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 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 |