diff options
Diffstat (limited to 'src/Xmobar/Plugins/Monitors/Weather.hs')
-rw-r--r-- | src/Xmobar/Plugins/Monitors/Weather.hs | 62 |
1 files changed, 39 insertions, 23 deletions
diff --git a/src/Xmobar/Plugins/Monitors/Weather.hs b/src/Xmobar/Plugins/Monitors/Weather.hs index 07d8cc4..250c258 100644 --- a/src/Xmobar/Plugins/Monitors/Weather.hs +++ b/src/Xmobar/Plugins/Monitors/Weather.hs @@ -19,11 +19,13 @@ import Xmobar.Plugins.Monitors.Common import qualified Control.Exception as CE -import Network.HTTP.Conduit -import Network.HTTP.Types.Status -import Network.HTTP.Types.Method +import Control.Monad.Reader (asks) import qualified Data.ByteString.Lazy.Char8 as B import Data.Char (toLower) +import Data.IORef (readIORef) +import Network.HTTP.Conduit +import Network.HTTP.Types.Method (methodHead) +import Network.HTTP.Types.Status import Text.ParserCombinators.Parsec import System.Console.GetOpt (ArgDescr(ReqArg), OptDescr(Option)) @@ -208,15 +210,18 @@ defUrl = "https://tgftp.nws.noaa.gov/data/observations/metar/decoded/" stationUrl :: String -> String stationUrl station = defUrl ++ station ++ ".TXT" -getData :: String -> IO String -getData station = CE.catch (do - manager <- newManager tlsManagerSettings - request <- parseUrlThrow $ stationUrl station - res <- httpLbs request manager - return $ B.unpack $ responseBody res - ) errHandler - where errHandler :: CE.SomeException -> IO String - errHandler _ = return "<Could not retrieve data>" +-- | Get the decoded weather data from the given station. +getData :: String -> Monitor String +getData station = do + man <- io =<< readIORef <$> asks manager + io $ CE.catch ( do + request <- parseUrlThrow $ stationUrl station + res <- httpLbs request man + return $ B.unpack $ responseBody res + ) errHandler + where + errHandler :: CE.SomeException -> IO String + errHandler _ = return "<Could not retrieve data>" formatSk :: Eq p => [(p, p)] -> p -> p formatSk ((a,b):sks) sk = if a == sk then b else formatSk sks sk @@ -242,27 +247,38 @@ showWeather :: String -> String -> String showWeather "" d = d showWeather s _ = s +-- | Run the 'Weather' monitor. runWeather :: [String] -> Monitor String runWeather = runWeather' [] -runWeather' :: [(String, String)] -> [String] -> Monitor String +-- | Run the 'WeatherX' monitor. +runWeather' + :: [(String, String)] -- ^ 'SkyConditionS' replacement strings + -> [String] -- ^ User supplied arguments + -> Monitor String runWeather' sks args = - do d <- io $ getData $ head args + do d <- getData $ head args o <- io $ parseOptsWith options defaultOpts args i <- io $ runP parseData d formatWeather o sks i +-- | Test internet connectivity before executing the monitor. weatherReady :: [String] -> Monitor Bool weatherReady str = do initRequest <- parseUrlThrow $ stationUrl $ head str let request = initRequest{method = methodHead} + man <- io =<< readIORef <$> asks manager 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 + res <- httpLbs request man + return $ checkResult $ responseStatus res ) errHandler + where + -- | If any exception occurs, indicate that the monitor is not ready. + errHandler :: CE.SomeException -> IO Bool + errHandler _ = return False + + -- | Check for and indicate any errors in the http response. + checkResult :: Status -> Bool + checkResult status + | statusIsServerError status = False + | statusIsClientError status = False + | otherwise = True |