diff options
Diffstat (limited to 'src/Plugins/Monitors/Weather.hs')
-rw-r--r-- | src/Plugins/Monitors/Weather.hs | 72 |
1 files changed, 57 insertions, 15 deletions
diff --git a/src/Plugins/Monitors/Weather.hs b/src/Plugins/Monitors/Weather.hs index dfc421e..3cfbc74 100644 --- a/src/Plugins/Monitors/Weather.hs +++ b/src/Plugins/Monitors/Weather.hs @@ -22,7 +22,6 @@ import Network.HTTP import Text.ParserCombinators.Parsec - weatherConfig :: IO MConfig weatherConfig = mkMConfig "<station>: <tempC>C, rh <rh>% (<hour>)" -- template @@ -32,12 +31,16 @@ weatherConfig = mkMConfig , "month" , "day" , "hour" - , "wind" + , "windCardinal" + , "windAzimuth" + , "windMph" + , "windKnots" , "visibility" , "skyCondition" , "tempC" , "tempF" - , "dewPoint" + , "dewPointC" + , "dewPointF" , "rh" , "pressure" ] @@ -49,12 +52,16 @@ data WeatherInfo = , month :: String , day :: String , hour :: String - , wind :: String + , windCardinal :: String + , windAzimuth :: String + , windMph :: String + , windKnots :: String , visibility :: String , skyCondition :: String , tempC :: Int , tempF :: Int - , dewPoint :: String + , dewPointC :: Int + , dewPointF :: Int , humidity :: Int , pressure :: Int } deriving (Show) @@ -68,7 +75,41 @@ pTime = do y <- getNumbersAsString char ' ' (h:hh:mi:mimi) <- getNumbersAsString char ' ' - return (y, m, d ,([h]++[hh]++":"++[mi]++mimi)) + return (y, m, d ,h:hh:":"++mi:mimi) + +-- Occasionally there is no wind and a METAR report gives simply, "Wind: Calm:0" +pWind0 :: + ( + String -- cardinal direction + , String -- azimuth direction + , String -- speed (MPH) + , String -- speed (knot) + ) +pWind0 = + ("μ", "μ", "0", "0") + +pWind :: + Parser ( + String -- cardinal direction + , String -- azimuth direction + , String -- speed (MPH) + , String -- speed (knot) + ) +pWind = + let tospace = manyTill anyChar (char ' ') + wind0 = do manyTill skipRestOfLine (string "Wind: Calm:0") + return pWind0 + wind = do manyTill skipRestOfLine (string "Wind: from the ") + cardinal <- tospace + char '(' + azimuth <- tospace + string "degrees) at " + mph <- tospace + string "MPH (" + knot <- tospace + manyTill anyChar newline + return (cardinal, azimuth, mph, knot) + in try wind0 <|> wind pTemp :: Parser (Int, Int) pTemp = do let num = digit <|> char '-' <|> char '.' @@ -76,10 +117,10 @@ pTemp = do let num = digit <|> char '-' <|> char '.' manyTill anyChar $ char '(' c <- manyTill num $ char ' ' skipRestOfLine - return $ (floor (read c :: Double), floor (read f :: Double)) + return (floor (read c :: Double), floor (read f :: Double)) pRh :: Parser Int -pRh = do s <- manyTill digit $ (char '%' <|> char '.') +pRh = do s <- manyTill digit (char '%' <|> char '.') return $ read s pPressure :: Parser Int @@ -112,18 +153,19 @@ parseData = ) skipRestOfLine >> getAllBut "/" (y,m,d,h) <- pTime - w <- getAfterString "Wind: " + (wc, wa, wm, wk) <- pWind v <- getAfterString "Visibility: " sk <- getAfterString "Sky conditions: " skipTillString "Temperature: " (tC,tF) <- pTemp - dp <- getAfterString "Dew Point: " + skipTillString "Dew Point: " + (dC, dF) <- pTemp skipTillString "Relative Humidity: " rh <- pRh skipTillString "Pressure (altimeter): " p <- pPressure manyTill skipRestOfLine eof - return $ [WI st ss y m d h w v sk tC tF dp rh p] + return [WI st ss y m d h wc wa wm wk v sk tC tF dC dF rh p] defUrl :: String defUrl = "http://weather.noaa.gov/pub/data/observations/metar/decoded/" @@ -139,10 +181,10 @@ getData station = do errHandler _ = return "<Could not retrieve data>" formatWeather :: [WeatherInfo] -> Monitor String -formatWeather [(WI st ss y m d h w v sk tC tF dp r p)] = +formatWeather [WI st ss y m d h wc wa wm wk v sk tC tF dC dF r p] = do cel <- showWithColors show tC far <- showWithColors show tF - parseTemplate [st, ss, y, m, d, h, w, v, sk, cel, far, dp, show r , show p ] + parseTemplate [st, ss, y, m, d, h, wc, wa, wm, wk, v, sk, cel, far, show dC, show dF, show r , show p ] formatWeather _ = getConfigValue naString runWeather :: [String] -> Monitor String @@ -158,10 +200,10 @@ weatherReady str = do io $ CE.catch (simpleHTTP request >>= checkResult) errHandler where errHandler :: CE.IOException -> IO Bool errHandler _ = return False - checkResult result = do + checkResult result = case result of Left _ -> return False - Right response -> do + Right response -> case rspCode response of -- Permission or network errors are failures; anything -- else is recoverable. |