summaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
-rw-r--r--README14
-rw-r--r--src/Commands.hs7
-rw-r--r--src/Config.hs7
-rw-r--r--src/Plugins/DateZone.hs44
-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
-rw-r--r--xmobar.cabal9
9 files changed, 203 insertions, 60 deletions
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 <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