diff options
| -rw-r--r-- | readme.md | 37 | ||||
| -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, 198 insertions, 11 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 @@ -1520,16 +1537,16 @@ with the help of the greater xmobar and Haskell communities.  In particular, xmobar [incorporates patches] by Axel Angel, Ben  Boeckel, Duncan Burke, Roman Cheplyaka, Patrick Chilton, Nathaniel  Wesley Filardo, John Goerzen, Reto Hablützel, Juraj Hercek, Tomas -Janousek, Spencer Janssen, Jochen Keil, Lennart Kolmodin, Krzysztof -Kosciuszkiewicz, Dmitry Kurochkin, Todd Lunter, Robert J. Macomber, -Dmitry Malikov, David McLean, Marcin Mikołajczyk, Dino Morelli, Tony -Morris, Eric Mrak, Thiago Negri, Edward O'Callaghan, Svein Ove, Martin -Perner, Jens Petersen, Alexander Polakov, Petr Rockai, Andrew -Sackville-West, Markus Scherer, Alexander Shabalin, Peter Simons, -Alexander Solovyov, John Soros, Travis Staton, Artem Tarasov, Samuli -Thomasson, Edward Tjörnhammar, Sergei Trofimovich, Thomas Tuegel, Jan -Vornberger, Anton Vorontsov, Daniel Wagner, Phil Xiaojun Hu, Edward -Z. Yang and Norbert Zeh. +Janousek, Spencer Janssen, Roman Joost, Jochen Keil, Lennart Kolmodin, +Krzysztof Kosciuszkiewicz, Dmitry Kurochkin, Todd Lunter, Robert +J. Macomber, Dmitry Malikov, David McLean, Marcin Mikołajczyk, Dino +Morelli, Tony Morris, Eric Mrak, Thiago Negri, Edward O'Callaghan, +Svein Ove, Martin Perner, Jens Petersen, Alexander Polakov, Petr +Rockai, Andrew Sackville-West, Markus Scherer, Alexander Shabalin, +Peter Simons, Alexander Solovyov, John Soros, Travis Staton, Artem +Tarasov, Samuli Thomasson, Edward Tjörnhammar, Sergei Trofimovich, +Thomas Tuegel, Jan Vornberger, Anton Vorontsov, Daniel Wagner, Phil +Xiaojun Hu, Edward Z. Yang and Norbert Zeh.  [jao]: http://jao.io  [incorporates patches]: http://www.ohloh.net/p/xmobar/contributors 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 | 
