diff options
-rw-r--r-- | readme.md | 17 | ||||
-rw-r--r-- | src/Plugins/Monitors.hs | 12 | ||||
-rw-r--r-- | src/Plugins/Monitors/UVMeter.hs | 150 | ||||
-rw-r--r-- | xmobar.cabal | 10 |
4 files changed, 188 insertions, 1 deletions
@@ -157,6 +157,9 @@ Otherwise, you'll need to install them yourself. : Support for xpm image file format. This will allow loading .xpm files in `<icon>`. Requires the [libXpm] C library. +`with_uvmeter` +: Enables UVMeter plugin. The plugin shows UV data for Australia. + `all_extensions` : Enables all the extensions above. @@ -1243,6 +1246,20 @@ more than one battery. Run CatInt 0 "/sys/devices/platform/thinkpad_hwmon/fan1_input" [] 50 +### `UVMeter` + +- Aliases to "uv " + station id. For example: `%uv brisbane%` or `%uv + alice springs%` +- Args: default monitor arguments. + +- *Reminder:* Keep the refresh rate high, to avoid making unnecessary + requests every time the plug-in is run. +- Station IDs can be found here: + http://www.arpansa.gov.au/uvindex/realtime/xml/uvvalues.xml +- Example: + + Run UVMeter "brisbane" ["-H", "3", "-L", "3", "--low", "green", "--high", "red"] 900 + ## Executing External Commands In order to execute an external command you can either write the diff --git a/src/Plugins/Monitors.hs b/src/Plugins/Monitors.hs index bee3c06..84eceb2 100644 --- a/src/Plugins/Monitors.hs +++ b/src/Plugins/Monitors.hs @@ -36,6 +36,9 @@ import Plugins.Monitors.Disk import Plugins.Monitors.Top import Plugins.Monitors.Uptime import Plugins.Monitors.CatInt +#ifdef UVMETER +import Plugins.Monitors.UVMeter +#endif #ifdef IWLIB import Plugins.Monitors.Wireless #endif @@ -71,6 +74,9 @@ data Monitors = Weather Station Args Rate | TopMem Args Rate | Uptime Args Rate | CatInt Int FilePath Args Rate +#ifdef UVMETER + | UVMeter Station Args Rate +#endif #ifdef IWLIB | Wireless Interface Args Rate #endif @@ -119,6 +125,9 @@ instance Exec Monitors where alias (DiskIO {}) = "diskio" alias (Uptime _ _) = "uptime" alias (CatInt n _ _ _) = "cat" ++ show n +#ifdef UVMETER + alias (UVMeter s _ _) = "uv " ++ s +#endif #ifdef IWLIB alias (Wireless i _ _) = i ++ "wi" #endif @@ -155,6 +164,9 @@ instance Exec Monitors where start (DiskIO s a r) = startDiskIO s a r start (Uptime a r) = runM a uptimeConfig runUptime r start (CatInt _ s a r) = runM a catIntConfig (runCatInt s) r +#ifdef UVMETER + start (UVMeter s a r) = runM (a ++ [s]) uvConfig runUVMeter r +#endif #ifdef IWLIB start (Wireless i a r) = runM a wirelessConfig (runWireless i) r #endif diff --git a/src/Plugins/Monitors/UVMeter.hs b/src/Plugins/Monitors/UVMeter.hs new file mode 100644 index 0000000..5fa0b82 --- /dev/null +++ b/src/Plugins/Monitors/UVMeter.hs @@ -0,0 +1,150 @@ +{-# LANGUAGE OverloadedStrings #-} +----------------------------------------------------------------------------- +-- | +-- Module : Plugins.Monitors.UVMeter +-- Copyright : (c) Róman Joost +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Róman Joost +-- Stability : unstable +-- Portability : unportable +-- +-- An australian uv monitor for Xmobar +-- +----------------------------------------------------------------------------- + +module Plugins.Monitors.UVMeter where + +import Plugins.Monitors.Common + +import qualified Control.Exception as CE +import Control.Applicative hiding ((<|>),many) +import Network.HTTP +import Text.Read (readMaybe) +import Text.Parsec +import Text.Parsec.String + + +uvConfig :: IO MConfig +uvConfig = mkMConfig + "<station>" -- template + ["station" -- available replacements + ] + +data UvInfo = UV { index :: String } + deriving (Show) + +uvURL :: String +uvURL = "http://www.arpansa.gov.au/uvindex/realtime/xml/uvvalues.xml" + +getData :: IO String +getData = do + let request = getRequest uvURL + CE.catch (simpleHTTP request >>= getResponseBody) errHandler + where errHandler :: CE.IOException -> IO String + errHandler _ = return "<Could not retrieve data>" + +textToXMLDocument :: String -> Either ParseError [XML] +textToXMLDocument = parse document "" + +formatUVRating :: Maybe Float -> Monitor String +formatUVRating Nothing = getConfigValue naString +formatUVRating (Just x) = do + uv <- showWithColors show x + parseTemplate [uv] + +getUVRating :: String -> [XML] -> Maybe Float +getUVRating locID (Element "stations" _ y:_) = getUVRating locID y +getUVRating locID (Element "location" [Attribute attr] ys:xs) + | locID == snd attr = getUVRating locID ys + | otherwise = getUVRating locID xs +getUVRating _ (Element "index" [] [Body rate]:_) = readMaybe rate +getUVRating locID (_:xs) = getUVRating locID xs +getUVRating _ [] = Nothing + + +runUVMeter :: [String] -> Monitor String +runUVMeter [] = return "N.A." +runUVMeter (s:_) = do + resp <- io getData + case textToXMLDocument resp of + Right doc -> formatUVRating (getUVRating s doc) + Left _ -> getConfigValue naString + +-- | XML Parsing code comes here. +-- This is a very simple XML parser to just deal with the uvvalues.xml +-- provided by ARPANSA. If you work on a new plugin which needs an XML +-- parser perhaps consider using a real XML parser and refactor this +-- plug-in to us it as well. +-- +-- Note: This parser can not deal with short tags. +-- +-- Kudos to: Charlie Harvey for his article about writing an XML Parser +-- with Parsec. +-- + +type AttrName = String +type AttrValue = String + +data Attribute = Attribute (AttrName, AttrValue) + deriving (Show) + +data XML = Element String [Attribute] [XML] + | Decl String + | Body String + deriving (Show) + +-- | parse the document +-- +document :: Parser [XML] +document = do + spaces + y <- try xmlDecl <|> tag + spaces + x <- many tag + spaces + return (y : x) + +-- | parse any tags +-- +tag :: Parser XML +tag = do + char '<' + spaces + name <- many (letter <|> digit) + spaces + attr <- many attribute + spaces + string ">" + eBody <- many elementBody + endTag name + spaces + return (Element name attr eBody) + +xmlDecl :: Parser XML +xmlDecl = do + string "<?xml" + decl <- many (noneOf "?>") + string "?>" + return (Decl decl) + +elementBody :: Parser XML +elementBody = spaces *> try tag <|> text + +endTag :: String -> Parser String +endTag str = string "</" *> string str <* char '>' + +text :: Parser XML +text = Body <$> many1 (noneOf "><") + +attribute :: Parser Attribute +attribute = do + name <- many (noneOf "= />") + spaces + char '=' + spaces + char '"' + value <- many (noneOf "\"") + char '"' + spaces + return (Attribute (name, value)) diff --git a/xmobar.cabal b/xmobar.cabal index 5694f12..d066cfe 100644 --- a/xmobar.cabal +++ b/xmobar.cabal @@ -74,6 +74,10 @@ flag with_threaded description: Use threaded runtime. default: False +flag with_uvmeter + description: UVMeter only useful to australians. + default: False + executable xmobar hs-source-dirs: src main-is: Main.hs @@ -93,7 +97,8 @@ executable xmobar Plugins.Monitors.Swap, Plugins.Monitors.Thermal, Plugins.Monitors.ThermalZone, Plugins.Monitors.Top, Plugins.Monitors.Uptime, Plugins.Monitors.Weather, - Plugins.Monitors.Bright, Plugins.Monitors.CatInt + Plugins.Monitors.Bright, Plugins.Monitors.CatInt, + Plugins.Monitors.UVMeter ghc-prof-options: -prof -auto-all ghc-options: -funbox-strict-fields -Wall -fno-warn-unused-do-bind @@ -176,3 +181,6 @@ executable xmobar extra-libraries: Xpm other-modules: XPMFile cpp-options: -DXPM + + if flag(with_uvmeter) + cpp-options: -DUVMETER |