summaryrefslogtreecommitdiffhomepage
path: root/src/lib/Xmobar/Plugins/Monitors/Weather.hs
diff options
context:
space:
mode:
authorjao <jao@gnu.org>2018-11-25 15:10:29 +0000
committerjao <jao@gnu.org>2018-11-25 15:10:29 +0000
commit77df1ac30fa7af5948f7ff64f5fee9aed64552b3 (patch)
tree647a4eb67ff1c293a5c530538ee88fc0093b577a /src/lib/Xmobar/Plugins/Monitors/Weather.hs
parente0d6da82de8d0d1cef98896164c6016b84e47068 (diff)
downloadxmobar-77df1ac30fa7af5948f7ff64f5fee9aed64552b3.tar.gz
xmobar-77df1ac30fa7af5948f7ff64f5fee9aed64552b3.tar.bz2
Back to app/src, since it seems they're the default convention for stack
Diffstat (limited to 'src/lib/Xmobar/Plugins/Monitors/Weather.hs')
-rw-r--r--src/lib/Xmobar/Plugins/Monitors/Weather.hs255
1 files changed, 0 insertions, 255 deletions
diff --git a/src/lib/Xmobar/Plugins/Monitors/Weather.hs b/src/lib/Xmobar/Plugins/Monitors/Weather.hs
deleted file mode 100644
index cb5bf07..0000000
--- a/src/lib/Xmobar/Plugins/Monitors/Weather.hs
+++ /dev/null
@@ -1,255 +0,0 @@
-{-# LANGUAGE CPP #-}
------------------------------------------------------------------------------
--- |
--- Module : Plugins.Monitors.Weather
--- Copyright : (c) Andrea Rossato
--- License : BSD-style (see LICENSE)
---
--- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org>
--- Stability : unstable
--- Portability : unportable
---
--- A weather monitor for Xmobar
---
------------------------------------------------------------------------------
-
-module Xmobar.Plugins.Monitors.Weather where
-
-import Xmobar.Plugins.Monitors.Common
-
-import qualified Control.Exception as CE
-
-#ifdef HTTP_CONDUIT
-import Network.HTTP.Conduit
-import Network.HTTP.Types.Status
-import Network.HTTP.Types.Method
-import qualified Data.ByteString.Lazy.Char8 as B
-#else
-import Network.HTTP
-#endif
-
-import Text.ParserCombinators.Parsec
-
-weatherConfig :: IO MConfig
-weatherConfig = mkMConfig
- "<station>: <tempC>C, rh <rh>% (<hour>)" -- template
- ["station" -- available replacements
- , "stationState"
- , "year"
- , "month"
- , "day"
- , "hour"
- , "windCardinal"
- , "windAzimuth"
- , "windMph"
- , "windKnots"
- , "windKmh"
- , "windMs"
- , "visibility"
- , "skyCondition"
- , "tempC"
- , "tempF"
- , "dewPointC"
- , "dewPointF"
- , "rh"
- , "pressure"
- ]
-
-data WindInfo =
- WindInfo {
- windCardinal :: String -- cardinal direction
- , windAzimuth :: String -- azimuth direction
- , windMph :: String -- speed (MPH)
- , windKnots :: String -- speed (knot)
- , windKmh :: String -- speed (km/h)
- , windMs :: String -- speed (m/s)
- } deriving (Show)
-
-data WeatherInfo =
- WI { stationPlace :: String
- , stationState :: String
- , year :: String
- , month :: String
- , day :: String
- , hour :: String
- , windInfo :: WindInfo
- , visibility :: String
- , skyCondition :: String
- , tempC :: Int
- , tempF :: Int
- , dewPointC :: Int
- , dewPointF :: Int
- , humidity :: Int
- , pressure :: Int
- } 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)
-
-noWind :: WindInfo
-noWind = WindInfo "μ" "μ" "0" "0" "0" "0"
-
-pWind :: Parser WindInfo
-pWind =
- let tospace = manyTill anyChar (char ' ')
- toKmh knots = knots $* 1.852
- toMs knots = knots $* 0.514
- ($*) :: String -> Double -> String
- op1 $* op2 = show (round ((read op1::Double) * op2)::Integer)
-
- -- Occasionally there is no wind and a METAR report gives simply, "Wind: Calm:0"
- wind0 = do manyTill skipRestOfLine (string "Wind: Calm:0")
- return noWind
- windVar = do manyTill skipRestOfLine (string "Wind: Variable at ")
- mph <- tospace
- string "MPH ("
- knot <- tospace
- manyTill anyChar newline
- return $ WindInfo "μ" "μ" mph knot (toKmh knot) (toMs knot)
- 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 $ WindInfo cardinal azimuth mph knot (toKmh knot) (toMs knot)
- in try wind0 <|> try windVar <|> try wind <|> return noWind
-
-pTemp :: Parser (Int, Int)
-pTemp = do let num = digit <|> char '-' <|> char '.'
- f <- manyTill num $ char ' '
- manyTill anyChar $ char '('
- c <- manyTill num $ char ' '
- skipRestOfLine
- return (floor (read c :: Double), floor (read f :: Double))
-
-pRh :: Parser Int
-pRh = do s <- manyTill digit (char '%' <|> char '.')
- return $ read s
-
-pPressure :: Parser Int
-pPressure = do manyTill anyChar $ char '('
- s <- manyTill digit $ char ' '
- skipRestOfLine
- return $ read s
-
-{-
- example of 'http://weather.noaa.gov/pub/data/observations/metar/decoded/VTUD.TXT':
- Station name not available
- Aug 11, 2013 - 10:00 AM EDT / 2013.08.11 1400 UTC
- Wind: from the N (350 degrees) at 1 MPH (1 KT):0
- Visibility: 4 mile(s):0
- Sky conditions: mostly clear
- Temperature: 77 F (25 C)
- Dew Point: 73 F (23 C)
- Relative Humidity: 88%
- Pressure (altimeter): 29.77 in. Hg (1008 hPa)
- ob: VTUD 111400Z 35001KT 8000 FEW030 25/23 Q1008 A2977 INFO R RWY30
- cycle: 14
--}
-parseData :: Parser [WeatherInfo]
-parseData =
- do (st, ss) <- try (string "Station name not available" >> return ("??", "??")) <|>
- (do st <- getAllBut ","
- space
- ss <- getAllBut "("
- return (st, ss)
- )
- skipRestOfLine >> getAllBut "/"
- (y,m,d,h) <- pTime
- w <- pWind
- v <- getAfterString "Visibility: "
- sk <- getAfterString "Sky conditions: "
- skipTillString "Temperature: "
- (tC,tF) <- pTemp
- 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 dC dF rh p]
-
-defUrl :: String
--- "http://weather.noaa.gov/pub/data/observations/metar/decoded/"
-defUrl = "http://tgftp.nws.noaa.gov/data/observations/metar/decoded/"
-
-stationUrl :: String -> String
-stationUrl station = defUrl ++ station ++ ".TXT"
-
-getData :: String -> IO String
-#ifdef HTTP_CONDUIT
-getData station = CE.catch (do
- manager <- newManager tlsManagerSettings
- request <- parseUrl $ stationUrl station
- res <- httpLbs request manager
- return $ B.unpack $ responseBody res
- ) errHandler
- where errHandler :: CE.SomeException -> IO String
- errHandler _ = return "<Could not retrieve data>"
-#else
-getData station = do
- let request = getRequest (stationUrl station)
- CE.catch (simpleHTTP request >>= getResponseBody) errHandler
- where errHandler :: CE.IOException -> IO String
- errHandler _ = return "<Could not retrieve data>"
-#endif
-
-formatWeather :: [WeatherInfo] -> Monitor String
-formatWeather [WI st ss y m d h (WindInfo wc wa wm wk wkh wms) v sk tC tF dC dF r p] =
- do cel <- showWithColors show tC
- far <- showWithColors show tF
- parseTemplate [st, ss, y, m, d, h, wc, wa, wm, wk, wkh, wms, v, sk, cel, far, show dC, show dF, show r , show p ]
-formatWeather _ = getConfigValue naString
-
-runWeather :: [String] -> Monitor String
-runWeather str =
- do d <- io $ getData $ head str
- i <- io $ runP parseData d
- formatWeather i
-
-weatherReady :: [String] -> Monitor Bool
-#ifdef HTTP_CONDUIT
-weatherReady str = do
- initRequest <- parseUrl $ stationUrl $ head str
- let request = initRequest{method = methodHead}
- io $ CE.catch ( do
- manager <- newManager tlsManagerSettings
- res <- httpLbs request manager
- return $ checkResult $responseStatus res ) errHandler
- where errHandler :: CE.SomeException -> IO Bool
- errHandler _ = return False
- checkResult status
- | statusIsServerError status = False
- | statusIsClientError status = False
- | otherwise = True
-#else
-weatherReady str = do
- let station = head str
- request = headRequest (stationUrl station)
- io $ CE.catch (simpleHTTP request >>= checkResult) errHandler
- where errHandler :: CE.IOException -> IO Bool
- errHandler _ = return False
- checkResult result =
- case result of
- Left _ -> return False
- Right response ->
- case rspCode response of
- -- Permission or network errors are failures; anything
- -- else is recoverable.
- (4, _, _) -> return False
- (5, _, _) -> return False
- (_, _, _) -> return True
-#endif