summaryrefslogtreecommitdiffhomepage
path: root/src/Xmobar/Plugins/Monitors/Weather.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Xmobar/Plugins/Monitors/Weather.hs')
-rw-r--r--src/Xmobar/Plugins/Monitors/Weather.hs62
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