summaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
-rw-r--r--readme.md17
-rw-r--r--src/Plugins/Monitors.hs12
-rw-r--r--src/Plugins/Monitors/UVMeter.hs150
-rw-r--r--xmobar.cabal10
4 files changed, 188 insertions, 1 deletions
diff --git a/readme.md b/readme.md
index 7ecea56..7f1be52 100644
--- a/readme.md
+++ b/readme.md
@@ -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