summaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
-rw-r--r--Monitors/Weather.hs205
1 files changed, 122 insertions, 83 deletions
diff --git a/Monitors/Weather.hs b/Monitors/Weather.hs
index 994227e..d643bb0 100644
--- a/Monitors/Weather.hs
+++ b/Monitors/Weather.hs
@@ -1,95 +1,123 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module : Monitors.Weather
+-- Copyright : (c) Andrea Rossato
+-- License : BSD-style (see LICENSE)
+--
+-- Maintainer : Andrea Rossato <andrea.rossato@unibz.it>
+-- Stability : unstable
+-- Portability : unportable
+--
+-- A weather monitor for XMobar
+--
+-----------------------------------------------------------------------------
+
module Main where
-import Text.ParserCombinators.Parsec
-import System.Environment
+import Monitors.Common
+
+import Data.IORef
import System.Process
import System.Exit
import System.IO
+import Text.ParserCombinators.Parsec
-data Config =
- Config { weatherNormal :: Integer
- , weatherNormalColor :: String
- , weatherCritical :: Integer
- , weatherCriticalColor :: String
- }
-
-defaultConfig :: Config
-defaultConfig =
- Config { weatherNormal = 0
- , weatherNormalColor = "#00FF00"
- , weatherCritical = 50
- , weatherCriticalColor = "#FF0000"
- }
-
-config :: Config
-config = defaultConfig
-
-
-data WeatherInfo = Fail String
- | WI { station :: String
- , time :: String
- , temperature :: Int
- , humidity :: Int
- }
-
-instance Show WeatherInfo where
- show (Fail _) = "N/A"
- show (WI st t temp rh) =
- st ++ ": " ++ (formatWeather temp) ++ "C, rh " ++ formatWeather rh ++
- "% (" ++ t ++ ")"
-
-parseData :: Parser WeatherInfo
-parseData =
- do { st <- manyTill anyChar $ char '('
- ; pNL
- ; manyTill anyChar $ char '/'
- ; space
- ; t <- manyTill anyChar newline
- ; manyTill pNL (string "Temperature")
- ; temp <- pTemp
- ; manyTill pNL (string "Relative Humidity")
- ; rh <- pRh
- ; manyTill pNL eof
- ; return $ WI st t temp rh
- }
-
-pTemp :: Parser Int
+monitorConfig :: IO MConfig
+monitorConfig =
+ do lc <- newIORef "#BFBFBF"
+ l <- newIORef 15
+ nc <- newIORef "#00FF00"
+ h <- newIORef 27
+ hc <- newIORef "#FF0000"
+ t <- newIORef "<station>: <tempC>C, rh <rh>% (<hour>)"
+ p <- newIORef package
+ u <- newIORef "station ID"
+ a <- newIORef []
+ e <- newIORef ["station"
+ , "stationState"
+ , "year"
+ , "month"
+ , "day"
+ , "hour"
+ , "wind"
+ , "visibility"
+ , "skyCondition"
+ , "tempC"
+ , "tempF"
+ , "dewPoint"
+ , "rh"
+ ,"pressure"
+ ]
+ return $ MC nc l lc h hc t p u a e
+
+
+data WeatherInfo =
+ WI { stationPlace :: String
+ , stationState :: String
+ , year :: String
+ , month :: String
+ , day :: String
+ , hour :: String
+ , wind :: String
+ , visibility :: String
+ , skyCondition :: String
+ , temperature :: Float
+ , dewPoint :: String
+ , humidity :: Float
+ , pressure :: String
+ } deriving (Show)
+
+
+
+pTime :: Parser (String, String, String, String)
+pTime = do y <- getNumbersAsString
+ char '.'
+ m <- getNumbersAsString
+ char '.'
+ d <- getNumbersAsString
+ char ' '
+ (h:hh:mi:mimi) <- getNumbersAsString
+ char ' '
+ return (y, m, d ,([h]++[hh]++":"++[mi]++mimi))
+
+pTemp :: Parser Float
pTemp = do string ": "
manyTill anyChar $ char '('
s <- manyTill digit $ (char ' ' <|> char '.')
- pNL
+ skipRestOfLine
return $read s
-pRh :: Parser Int
+pRh :: Parser Float
pRh = do string ": "
s <- manyTill digit $ (char '%' <|> char '.')
- return $read s
-
-pNL :: Parser Char
-pNL = do many $ noneOf "\n\r"
- newline
-
+ return $ read s
-runP :: Parser WeatherInfo -> String -> IO WeatherInfo
-runP p i =
- do case (parse p "" i) of
- Left err -> return $ Fail $ show err
- Right x -> return x
-
-formatWeather :: Int -> String
-formatWeather d | d > fromInteger (weatherCritical config) = setColor str weatherCriticalColor
- | d > fromInteger (weatherNormal config) = setColor str weatherNormalColor
- | otherwise = str
- where str = show d
-
-
-setColor :: String -> (Config -> String) -> String
-setColor str ty =
- "<fc=" ++ ty config ++ ">" ++
- str ++ "</fc>"
+parseData :: Parser [WeatherInfo]
+parseData =
+ do st <- getAllBut ","
+ space
+ ss <- getAllBut "("
+ skipRestOfLine >> getAllBut "/"
+ (y,m,d,h) <- pTime
+ skipRestOfLine >> string "Wind: "
+ w <- manyTill anyChar $ newline
+ manyTill skipRestOfLine $ string "Visibility: "
+ v <- manyTill anyChar $ newline
+ manyTill skipRestOfLine $ string "Sky conditions: "
+ sk <- manyTill anyChar $ newline
+ manyTill skipRestOfLine $ string "Temperature"
+ temp <- pTemp
+ manyTill skipRestOfLine $ string "Dew Point: "
+ dp <- manyTill anyChar $ newline
+ manyTill skipRestOfLine $ string "Relative Humidity"
+ rh <- pRh
+ manyTill skipRestOfLine $ string "Pressure (altimeter): "
+ p <- manyTill anyChar $ newline
+ manyTill skipRestOfLine eof
+ return $ [WI st ss y m d h w v sk temp dp rh p]
defUrl :: String
defUrl = "http://weather.noaa.gov/pub/data/observations/metar/decoded/"
@@ -107,13 +135,24 @@ getData url=
_ -> do closeHandles
return "Could not retrieve data"
+formatWeather :: [WeatherInfo] -> Monitor String
+formatWeather [(WI st ss y m d h w v sk temp dp r p)] =
+ do cel <- showWithColors show temp
+ far <- showWithColors (show . takeDigits 1) (((9 / 5) * temp) + 32)
+ rh <- showWithColors show r
+ parseTemplate [st, ss, y, m, d, h, w, v, sk, cel, far, dp, rh , p ]
+formatWeather _ = return "N/A"
+
+runWeather :: [String] -> Monitor String
+runWeather str =
+ do d <- io $ getData $ head str
+ i <- io $ runP parseData d
+ formatWeather i
+
+package :: String
+package = "xmb-weather"
+
main :: IO ()
main =
- do args <- getArgs
- str <- if length args /= 1
- then error $ "No Station ID specified.\nUsage: weather STATION_ID" ++
- "\nExample: xmb-weather LIPB"
- else getData (args !! 0)
- i <- runP parseData str
- putStrLn $ show i
-
+ do let af = return "No station ID specified"
+ runMonitor monitorConfig af runWeather