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 | 
