blob: 5fa0b8273c0003c8a9d6d528538491e98553c5e0 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
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))
|
